Excel【Csvファイル】VBA検索後、検索データを活用する
前回のおさらい
Csvファイルを検索し、検索結果をワークシートに表示しました。
検索結果を利用する
検索結果を利用するには、
・検索結果を別シートに貼付し、計算式で必要なセルに連携させる
・検索結果の必要な値を必要なセルに貼付する
・検索結果を必要なセルに手入力する
方法が考えられます。
これをマクロ(VBA開発)で自動化していきます。
売上管理表は仕入日の履歴になっています。
【 品目 】の元帳があるとします。
検索結果を表示すると同時に、元帳にも表示されるようにします。
標準モジュールを追加します。
Sub CsvReadAndWrthinmoku()
Dim clsTm As clsTimer
Dim Ws As Worksheet
Dim sttTime As Double
Dim endTime As Double
Dim prsTime As Double
Set clsTm = New clsTimer
Set Ws = ThisWorkbook.Worksheets("Sheet1")
sttTime = clsTm.startTime
Call CsvSqlRead
Call WrtHinmoku
endTime = clsTm.endTime
prsTime = clsTm.processTime(sttTime, endTime)
Ws.Range("L1").Value = prsTime
Set clsTm = Nothing
End Sub
Sub WrtHinmoku()
Dim Ws As Worksheet
Dim ItigoCnt As Long
Dim MikanCnt As Long
Dim BudoCnt As Long
Dim AppleCnt As Long
Dim EndRow As Long
Set Ws = ThisWorkbook.Worksheets("Sheet1")
With Ws
EndRow = .Cells(Rows.Count, 1).End(xlUp).Row
ItigoCnt = WorksheetFunction.CountIfs(.Range("B4:B" & EndRow), "いちご")
MikanCnt = WorksheetFunction.CountIfs(.Range("B4:B" & EndRow), "みかん")
BudoCnt = WorksheetFunction.CountIfs(.Range("B4:B" & EndRow), "ぶどう")
AppleCnt = WorksheetFunction.CountIfs(.Range("B4:B" & EndRow), "りんご")
If ItigoCnt > 0 Then
.Range("J5:M" & ItigoCnt + 4).Value = .Range("C5:F" & ItigoCnt + 4).Value
End If
If MikanCnt > 0 Then
.Range("O5:R" & MikanCnt + 4).Value = .Range("C5:F" & MikanCnt + 4).Value
End If
If BudoCnt > 0 Then
.Range("J15:M" & BudoCnt + 12).Value = .Range("C5:F" & BudoCnt + 4).Value
End If
If AppleCnt > 0 Then
.Range("O15:R" & AppleCnt + 12).Value = .Range("C5:F" & AppleCnt + 4).Value
End If
End With
End Sub
【 品目 】: ぶとう を検索してみます。
ぶどうの検索時間は、0.2秒
検索+元帳書込時間は、約1.8秒
同様に他の品目も検索します。
はい、ちゃんと表示されました。
検索結果を元帳に記帳する方法を考えました。
しかし、品目が4種類あり、4回検索しました。
品目が増えると、検索回数も増えることになります。
実務では、仕入日に売上管理表と元帳を記帳するのではないかと思います。
仕入日で検索し、元帳に記帳されるようにします。
前回で「仕入日」の検索機能は、作成済です。
元帳のすべての品目に記帳出来るようにします。
標準モジュールを追加します。
Sub CsvReadAndWrthinmokuAll()
Dim clsTm As clsTimer
Dim Ws As Worksheet
Dim sttTime As Double
Dim endTime As Double
Dim prsTime As Double
Set clsTm = New clsTimer
Set Ws = ThisWorkbook.Worksheets("Sheet1")
sttTime = clsTm.startTime
Call CsvSqlRead
Call WrtHinmokuAll
endTime = clsTm.endTime
prsTime = clsTm.processTime(sttTime, endTime)
Ws.Range("L1").Value = prsTime
Set clsTm = Nothing
End Sub
Sub WrtHinmokuAll()
Dim Ws As Worksheet
Dim EndRow As Long
Dim Hinmoku As String
Set Ws = ThisWorkbook.Worksheets("Sheet1")
With Ws
EndRow = .Cells(Rows.Count, 1).End(xlUp).Row
For gyo = 1 To EndRow - 4
Hinmoku = .Cells(4 + gyo, 2).Value
Select Case Hinmoku
Case Is = "みかん"
.Range("O" & MikanGyo & ":R" & MikanGyo).Value = .Range("C" & 4 + gyo & ":F" & 4 + gyo).Value
Case Is = "いちご"
.Range("J" & ItigoGyo & ":M" & ItigoGyo).Value = .Range("C" & 4 + gyo & ":F" & 4 + gyo).Value
Case Is = "りんご"
.Range("O" & AppleGyo & ":R" & AppleGyo).Value = .Range("C" & 4 + gyo & ":F" & 4 + gyo).Value
Case Is = "ぶどう"
.Range("J" & BudoGyo & ":M" & BudoGyo).Value = .Range("C" & 4 + gyo & ":F" & 4 + gyo).Value
End Select
Next
End With
End Sub
【 仕入日 】:10月15日 を検索します。
仕入日の検索時間は、0.2秒
検索+元帳書込時間は、2秒
マクロ(VBA開発)を使用した【Csvファイル】の検索データの
活用方法を紹介しました。