エクセルVBA 請求データ一覧からの複数の処理

質問

• エクセルVBAを使用して、請求データ一覧から複数の処理を行う方法を教えてください。
• 請求データ一覧の中で特定の行まで繰り返し同じ処理を行いたいです。具体的には、行単位でデータを抽出し、別のシートの特定の列から条件に合致するデータを参照し、金額を合計して請求書のひな形に入力する方法です。
• エクセルVBAのコードを使って、Worksheet1からデータを抽出し、Worksheet2の特定の列を参照し、条件に合致する金額を合計して請求書のひな形に入力する方法を教えてください。

回答No.1

kkkkkm

> 　　　List４に記載のコードに該当していれば、
> 　　　そのコードの金額を合計し、
> 　　　Worksheet3"請求書ひな形"のセル「N2」に入力
>
> 　　　セル「AN」の値を
> 　　　Worksheet3"請求書ひな形"のセル「M2」に転記

これは逆ではないでしょうか。とりあえず逆で考えてますので、逆でなければ最後の所で変更してください。

前回のTest4()をもとに書き替えました。

Sub Test5()
Dim i As Long, j As Long, k As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Dim mTotal(4) As Long
Dim LastRow As Long
Dim List(4) As Variant

Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")
Set Ws3 = Sheets("Sheet3")

List(1) = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp)).Value
List(2) = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp)).Value
List(3) = Ws2.Range(Ws2.Cells(1, "C"), Ws2.Cells(Rows.Count, "C").End(xlUp)).Value
List(4) = Ws2.Range(Ws2.Cells(1, "D"), Ws2.Cells(Rows.Count, "D").End(xlUp)).Value

LastRow = UBound(List(1))

For i = 1 To 3
If UBound(List(i)) < UBound(List(i + 1)) Then
LastRow = UBound(List(i + 1))
End If
Next

For i = 2 To Ws1.Cells(Rows.Count, "J").End(xlUp).Row
mTotal(1) = 0
mTotal(2) = 0
mTotal(3) = 0
mTotal(4) = 0
For j = Columns("J").Column To Columns("AM").Column Step 3
If Ws1.Cells(i, j).Value = "" Then
Exit For
End If
For k = 2 To LastRow
If UBound(List(1)) >= k Then
If Ws1.Cells(i, j).Value = List(1)(k, 1) Then
mTotal(1) = mTotal(1) + Ws1.Cells(i, j).Offset(0, 2).Value
Exit For
End If
End If
If UBound(List(2)) >= k Then
If Ws1.Cells(i, j).Value = List(2)(k, 1) Then
mTotal(2) = mTotal(2) + Ws1.Cells(i, j).Offset(0, 2).Value
Exit For
End If
End If
If UBound(List(3)) >= k Then
If Ws1.Cells(i, j).Value = List(3)(k, 1) Then
mTotal(3) = mTotal(3) + Ws1.Cells(i, j).Offset(0, 2).Value
Exit For
End If
End If
If UBound(List(4)) >= k Then
If Ws1.Cells(i, j).Value = List(4)(k, 1) Then
mTotal(4) = mTotal(4) + Ws1.Cells(i, j).Offset(0, 2).Value
Exit For
End If
End If
Next
Next
Ws3.Cells(i, "J").Value = mTotal(1)
Ws3.Cells(i, "K").Value = mTotal(2)
Ws3.Cells(i, "L").Value = mTotal(3)
Ws3.Cells(i, "M").Value = mTotal(4)
Ws3.Cells(i, "N").Value = Ws1.Cells(i, "AN").Value
Ws3.Cells(i, "O").Value = Ws1.Cells(i, "AO").Value
Next

Set Ws1 = Nothing
Set Ws2 = Nothing
Set Ws3 = Nothing
End Sub