無料VBA講座

Range("C4:C20")Select　　　　　　' これは、仮に記入しているものだから、前回実行してセルに
With Selection.Interior　　　　　　 ' 色が付いていたら色を無くしている。
　　. Pattern=xlNone
End With

Range("B2").Select
strSeib=Range("B2")+"*"　　　　　' これは、NR-4254*と言うことになる。
　　　　　　　　　　　　　　　　　　' NR-4254の後に、どの文字が付いていても抽出する。
Con=0　　　　　　　　　　　　　　 ' Con変数をゼロにしている。製番をカウントする。
Total=0　　　　　　　　　　　　　　' Total変数をゼロにする。

Set myRange=Worksheets("Sheet1").Range("C2:C" & intRow).Find(strSeib)
　' これは、Setを使用するときの書式である。
　' C2からCのintRowの値まで検索して、strSeibと一致するものを抽出して、myRangeに代入する。

If myRange Is Nothing Then GoTo JumpERR　　' myRangeが空白ならJumpERRへジャンプする。
If myRange <> " " Then Con=Con+1　　　　　 ' myRangeが空白でなかったら、Conに1を加算する。
intRow2=myRange.Row　　　　　　　　　　　 ' myRangeの行番号を取得してintRow2に代入する。
Range("C" & intRow2).Select　　　　　　　　　 ' C列のintRow2行を選択する。

With Selection.Interior　　　　　　　　　　　　' 選択した行を黄色にする。
　　.Pattern=xlSolid
　　.PatternColorIndex=xlAutomatic
　　.Color=65535 　　　　　　　　　　　　　　' 黄色の色コード番号
End With　　　　　　　　　　　　　　　　　　　'尚、この部分は、マクロ記録で作成したものである。

intKin=Worksheets("Sheet1")Range("B" & intRow2)
　　　　　　　　　　　　　　　　　　　　　　　' B列のintRow2の行の値をintKinに代入する。
Total=Total+intKin　　　　　　　　　　　　　　' TotalはTotalとintKinを加算したものある。
Range("D2").Value=" 製番数 " & Con　　　　　' D2に製番数を記入する。

　　●Total=Total+intKin の様に毎回 Total にintKinが発生するたびに加算すると、Totalは合計値になる。
　　●Do _ LoopはDoからLoopまでを繰り返す。抜け出す方法は数種類あるが、今回は下記の様に
　　　intRow2とintRが同じになったら、JumpEndへジャンプしている。

If intRow2=intR Then GoTo JumpEnd

Do
　　Set myRange=WorkSheets("Sheet1").Range("C2;C" & intRow).FindNext(myRange)
　　　　' C2からC列のintRow行までを、strSeibで検索するのだが、NR-4254Aは抽出されたのだから、
　　　　' (Next) その次を検索せよとなる。
　　intR=myRange.Row
　　　　' 次の抽出された値が、myRangeに代入されて、その値がintRに代入される。

　　If intRow2=intR Then GoTo JumpEnd
　　　　' DoからLoopまでの繰り返しは終わりがなくて、抜け出す条件が無かったら、シャットダウン
　　　　' するまで実行している。
　　　　' ここでは intRow2 を使用して、最初に抽出された行番号11を intRow2 に代入して、もう一度
　　　　' 11を検出して intR が 11になったときに、intRow2=intR Then でループから抜け出している。
　　　　● Find Nextは一通り抽出しても、また初めから検索しようとするので、Do から Loop の間を
　　　　　繰り返す、だから抜け出す手段が必要になる。

　　Range("C" & intR).Select　　　　　　　　　' ここでは行番号変数が intR に変わっている。
　　With Selection.Interior 　　　　　　　　　　' 選択して行を黄色にする。
　　　　.Pattern=xlSolid
　　　　. PatternColorIndex=xlAutomatic
　　　　. Color=65535
　　End With

　　intKin=Worksheets("Sheet1").Range("B" & intR)　　' B列の intR 行の金額が intKin に代入される。
　　Total=Total+intKin 　　　　　　　　　　　　　' Total に金額 intKin が加算されて Total 金額になる。
　　Range("D2").Value=Total　　　　　　　　　　' D2に Total金額を記入する。
　　Range("D2").Value="製番数” & Con

Loop
　　　　
GoTo JumpEnd　　　　　　　　　　　　　　　　　' JumpEndへジャンプする。

JumpERR:　　　　　　　　　　　　　　　　　　　' ジャンプ先の一番左側に記入する。[ : ]が必要
　　intKin="データなし" 　　　　　　　　　　　　' strSeibで検索して該当がなかったら
　　Range("D2").Value=intKin　　　　　　　　　' D2にintKinを記入する。

JumpEnd:
　　Set myRange=Nothing　　　　　　　　　　　' Set 使用時の myRange を取り消す。

End Sub　　　　　　　　　　　　　　　　　　　　' 終了

Dim intRow As Inteter 　　　　　　　　　　' intRowは数値であると宣言している。
Rabge("C2:D2").ClearContents　　　　　 ' 結果を表示するD2セルの内容を消去している。
intRow=Range("C3"),End(xlDown).Row　 ' C3から下にデータ行を調べて、最下行の番号をintRowと
　　　　　　　　　　　　　　　　　　　　　' 言う変数に代入する。
もし、最後のRowが無かったら、
intRow=Range("C3").End(xlDown)　　　　' この場合はintRowにSP-0124Uとセルの値が入る。

　又、intRowが数値で宣言されているのでエラーになる。
　Dim intRow As Variant に変更するとエラーにならないで、最終行の製番がintRowに入ることになる。

●Row は、行番を取得する。
●Variant は、数値でも文字でも取得したものを代入する。

コードの赤枠部分は、並べ替え（ソート）である。
FINDの必須条件として、検索列はデータが昇順に並んでなくてはならない。
だから、B4からD20までをソートしている。
intRow変数を使用することによって、どんな大きなデータベースでも対応できる。

Range("B4:D" & intRow).Select　　　　　　　' intRowは20だからB4:D20を選択する。
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 key:=Range("C4:C" & intRow), _
　　SortOn:=xlSortOn Values, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
　　.SetRange Range("B4:D" & intRow)
　　.Header=xlGuess
　　.MatchCase=False
　　.Orientation=xlTopToBottom 　　　　　　' 昇順ソート
　　.SortMethod=xlPinYin
　　.Apply
End With

ソートの書式はこのようなものと、覚えておけばよいのではないか。
マクロ記録で、その部分だけソートして、コードを使用すればよいのではないか。
但し、選択範囲の文法は修正が必要になる。
又、コード内に注釈を記入する場合は、[ ' ] が必要です。注釈文は実行されない。

Range("A1)".Select
strSeib=Range("B2)"　　　　　　　' B2の値を StrSeibに代入する。

Set myRange=Worksheets("Sheet1").Range("C2:D" & intRow).Find(what:=strSeib.LookAt:=xlWhole)
　' このコードは、strSeibの製番と完全一致のものが、C2からD20までにあれば、myRangeに代入される。

If myRange Is Nothing Then GoTo JumpERR
　' このコードは、myRangeが空白なら、JumpERRへジャンプすると言うものである。

intR=myRange.Row
　' このコードは、myRangeの行番をintRに代入する。

intDay=Worksheets("Sheet1").Range("D" & intR)
　' このコードは、D列のintR行のデータをintDayに代入する。

GoTo JumpEnd
　' このコードは、JumpEndへジャンプする。

JumpERR:
　' このコードは、ジャンプ先を定義するもので、全体プログラムを参照すれば分かるように、行の一番左
　　から書いている。　名前は、何でも良いが右側に[ : ]が必要である。

intDay="データなし"
　' JumpERRにジャンプすると実行する内容を書く。

intR=myRange.Row
intDay=Worksheets("Sheet1")Range("D" & intR)
GoTo JumpEnd