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

質問

VBA初心者です。
費目コード・費目名・金額を抽出したデータがあります。
例えば、横一列に
　A2：費目コード「A01」
　B2：費目名「XXXX」
　C2：金額「10,000」
　D2：費目コード「Z05」
E2：費目名「BBBB」
　F2：金額「5,000」
　　　　・
　　　　・
と1行に5～10の費目が抽出されています。
（1行目はタイトル行）

行毎が1件の請求となっていますが、
費目コード〇〇と▲▲は課税(非課税)対象として認識し、
その金額を合計したものを、worksheet2の特定のセルに
記載することは可能でしょうか。

説明が上手く出来ず申し訳ありません。
宜しくお願い致します。

回答No.9

kkkkkm · ベストアンサー

No.8の一部訂正です。

問題はないとも思いますが念のために

> For k = 2 To LastRow
> If Ws1.Cells(i, j).Value = List1.Cells(k, 1).Value Then
> mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value
> Exit For
> End If
> If Ws1.Cells(i, j).Value = List2.Cells(k, 1).Value Then
> mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value
> Exit For
> End If
> Next

の部分を以下のように変更してください。

For k = 2 To LastRow
If List1.Count >= k Then
If Ws1.Cells(i, j).Value = List1.Cells(k, 1).Value Then
mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value
Exit For
End If
End If
If List2.Count >= k Then
If Ws1.Cells(i, j).Value = List2.Cells(k, 1).Value Then
mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value
Exit For
End If
End If
Next

ついでですので、List1,List2を他の方法でやるやり方も記載しておきます。

Sub Test4()
Dim i As Long, j As Long, k As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim mTotal1 As Long, mTotal2 As Long
Dim LastRow As Long
Dim List1 As Variant, List2 As Variant

Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")
List1 = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp)).Value
List2 = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp)).Value

If UBound(List1) >= UBound(List2) Then
LastRow = UBound(List1)
Else
LastRow = UBound(List2)
End If

For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row
mTotal1 = 0
mTotal2 = 0
For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 2
For k = 2 To LastRow
If UBound(List1) >= k Then
If Ws1.Cells(i, j).Value = List1(k, 1) Then
mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value
Exit For
End If
End If
If UBound(List2) >= k Then
If Ws1.Cells(i, j).Value = List2(k, 1) Then
mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value
Exit For
End If
End If
Next
Next
Ws2.Cells(i, "J").Value = mTotal1
Ws2.Cells(i, "K").Value = mTotal2
Next

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub

お礼

詳細なご回答を有難うございました。
また、「補足」のルールをわかっておらず、
他の方にも参照としてしまい申し訳ございませんでした。
初心者で検証に時間がかかってしまうかと思いますが、
ご教示頂いた方法でやってみます。
本当に有難うございました。

回答No.8

kkkkkm

No.7の追加です。

No.7ではリストのセル指定が何度か出てくるので
それぞれ
List1
List2
として利用できるようにしました。

Sub Test3()
Dim i As Long, j As Long, k As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim mTotal1 As Long, mTotal2 As Long
Dim LastRow As Long
Dim List1 As Range, List2 As Range

Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")
Set List1 = Ws2.Range(Ws2.Cells(1, "A"), Ws2.Cells(Rows.Count, "A").End(xlUp))
Set List2 = Ws2.Range(Ws2.Cells(1, "B"), Ws2.Cells(Rows.Count, "B").End(xlUp))

If List1.Count >= List2.Count Then
LastRow = List1.Count
Else
LastRow = List2.Count
End If

For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row
mTotal1 = 0
mTotal2 = 0
For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 2
For k = 2 To LastRow
If Ws1.Cells(i, j).Value = List1.Cells(k, 1).Value Then
mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value
Exit For
End If
If Ws1.Cells(i, j).Value = List2.Cells(k, 1).Value Then
mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value
Exit For
End If
Next
Next
Ws2.Cells(i, "J").Value = mTotal1
Ws2.Cells(i, "K").Value = mTotal2
Next

Set List1 = Nothing
Set List2 = Nothing
Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub

回答No.7

kkkkkm

> 補足を入れさせて頂きました。

他の方への補足を参照させるのはいかがなものかと思いますが…。

コードリスト１及び２の場所が不明なので
Sheet2のA1からコードリスト１
Sheet2のB1からコードリスト２
として

質問では3列一組だったのに補足では2列一組になっているので2列一組と考えます。

Sub Test2()
Dim i As Long, j As Long, k As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim mTotal1 As Long, mTotal2 As Long
Dim LastRow As Long

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

If Ws2.Cells(Rows.Count, "A").End(xlUp).Row >= Ws2.Cells(Rows.Count, "B").End(xlUp).Row Then
LastRow = Ws2.Cells(Rows.Count, "A").End(xlUp).Row
Else
LastRow = Ws2.Cells(Rows.Count, "B").End(xlUp).Row
End If

For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row
mTotal1 = 0
mTotal2 = 0
For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 2
For k = 2 To LastRow
If Ws1.Cells(i, j).Value = Ws2.Cells(k, "A").Value Then
mTotal1 = mTotal1 + Ws1.Cells(i, j).Offset(0, 1).Value
Exit For
End If
If Ws1.Cells(i, j).Value = Ws2.Cells(k, "B").Value Then
mTotal2 = mTotal2 + Ws1.Cells(i, j).Offset(0, 1).Value
Exit For
End If
Next
Next
Ws2.Cells(i, "J").Value = mTotal1
Ws2.Cells(i, "K").Value = mTotal2
Next

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub

回答No.6

imogasi

既にVBAの回答も出ていますが、
５列で１レコード（行）（請求の中の明細のデータ単位）らしいから、
まず分解して下記のようにSheet2に分解後のデータを作り、その後の処理を考えたらどうか。VBAでか、関数でか。金額合計なら、SUMIF（SUMIFS）でもできそう。
ーーー
質問説明の書き方も下記のようにしたらどうか。回答よりも、この点を言いたい。
＜ーーー　＞説明が上手く出来ず申し訳ありません
OKWAVE画面の、回答のこの部分をコピし、自分のシートに貼りつける。その後２手間かけるが、データー区切り位置で、自分のシートに下記データが再現できるだろう。複雑なものだと列ずれを起こすかもしれないが。
データ例　Sheet1　A1:I4
費目コード 費目名 金額 費目コード 費目名 金額 費目コード 費目名 金額
A01 aaa 10000 Z05 bbb 5000 B02 ccc 8000
B01 ddd 10000 C01 eee 5000
C01 eee 50000 Z05 fff 7000 B02 ggg 20000
標準モジュールに
Sub ttest01()
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
K = 2 'アウトプット用　処理スタート行　Sheet2の第2行　１行目は見出し。本件では略。
lr = sh1.Range("A100000").End(xlUp).Row
'MsgBox lr
For i = 2 To lr '2行目から　１行目は見出し
rc = sh1.Cells(i, 1000).End(xlToLeft).Column
MsgBox rc
For j = 1 To rc Step 3 '３列ごと１まとまりだから
sh2.Cells(K, "A") = sh1.Cells(i, j)
sh2.Cells(K, "B") = sh1.Cells(i, j + 1)
sh2.Cells(K, "c") = sh1.Cells(i, j + 2)
K = K + 1　 '次回用に次行を指しておく
Next j
Next i
End Sub
ーーー
実行すると、
Sheet2のA2:C９
A01 aaa 10000
Z05 bbb 5000
B02 ccc 8000
B01 ddd 10000
C01 eee 5000
C01 eee 50000
Z05 fff 7000
B02 ggg 20000
その後の処理は略。簡単なので。

補足

早々にご回答頂きまして有難うございます。
質問の内容が不明瞭で申し訳ありません。
ご教示頂いたVBAや関数を悪戦苦闘して検証しております。。。

具体例をもう少しわかりやすく記載してみました。
2行目から実際の請求データになります。

　①各行のコードがコードリスト１及び２に記載がある
　　か参照する
　②リスト１に記載のコード／リスト２に記載のコード
　　でそれぞれ分けて金額を合計する
　③リスト１の合計金額
　　worksheet2の　「J2,J3・・・」のセルにそれぞれ
　　入力する
　　リスト２の合計金額
　　worksheet2の「K2,K3・・・」のセルにそれぞれ
　　入力する

下記の例ですと、
2行目・・・コードA01,Z05,B02はリスト1に該当
　　　　　 A01,Z05,B02の合計金額113000を
　　　　 　worksheet2の「J2」のセルに入力
3行目・・・コードP01,W01はリスト１に該当
　　　　　 P01,W01の合計金額67000を
　　　　 　worksheet2の「J3」のセルに入力
X01,Z01はリスト２に該当
　　　　　 X01,Z01の合計金額22200を
　　　　 　worksheet2の「K3」のセルに入力

A B C D E F G H
1 コード　金額 コード 金額 コード 金額 コード　金額
2 A01 100000 Z05 5000 B02 8000
3 P01 50000 W01 17000 X01 20000 Z01 　2200

コードリスト1
A01
A02
B01
B02
C01
C02
・
・
P01
W01
Z05

コードリスト2
X01
Y01
Z01

この操作がVBAで可能でしょうか・・・。
ご教示頂けると有難いです。

回答No.5

kkkkkm

Sheet2のG2から下に対象費目コード一覧ある場合です。

Sub Test2()
Dim i As Long, j As Long, k As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim mTotal As Currency

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

For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row
mTotal = 0
For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 3
For k = 2 To Ws2.Cells(Rows.Count, "G").End(xlUp).Row
If Ws1.Cells(i, j).Value = Ws2.Cells(k, "G").Value Then
mTotal = mTotal + Ws1.Cells(i, j).Offset(0, 2).Value
Exit For
End If
Next
Next
Ws2.Cells(i, "A").Value = mTotal
Next

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub

補足

早々にご回答頂きまして有難うございます。
質問の内容が不明瞭で申し訳ありません。
ご教示頂いたVBAや関数を悪戦苦闘して検証しております。。。

補足を入れさせて頂きました。
ご参照頂けると有難いです。

回答No.4

kkkkkm

合計したい費目コードや記載したいSheet2の場所が分からないので
行ごとに費目コード「A01」と「Z05」の合計をSheet2のA列同一行に記載する場合です。

Sub Test()
Dim i As Long, j As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim mTotal As Currency

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

For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row
mTotal = 0
For j = 1 To Ws1.Cells(i, Columns.Count).End(xlToLeft).Column Step 3
If Ws1.Cells(i, j).Value = "A01" Or Ws1.Cells(i, j).Value = "Z05" Then
mTotal = mTotal + Ws1.Cells(i, j).Offset(0, 2).Value
End If
Next
Ws2.Cells(i, "A").Value = mTotal
Next

Set Ws1 = Nothing
Set Ws2 = Nothing

End Sub

補足

早々にご回答頂きまして有難うございます。
質問の内容が不明瞭で申し訳ありません。
ご教示頂いたVBAや関数を悪戦苦闘して検証しております。。。

補足を入れさせて頂きました。
ご参照頂けると有難いです。

回答No.3

kon555

可能不可能で言えば可能です。ただし『費目コード〇〇と▲▲』のように条件が明確である必要があります。
　その条件がクリアされているなら、例えば別のシートなどで課税対象のリスト、非課税対象のリストを作成しておいて、データを上から参照していき、リストに従ってそれぞれの対象の合計を算出する形がとれます（あくまで一例です）。
　コード的にはifとforの組み合わせになるでしょう。
https://www.sejuku.net/blog/30059
https://valmore.work/excel-vba-for/

　またVBAでなくとも、対象リストがあれば関数だけでも対応可能です。方法は色々あるでしょうが、SUMIFSがシンプルで分かり易いと思います。
https://blog02.aqua-school.com/2019/07/26/excel-35/

補足

早々にご回答頂きまして有難うございます。
質問の内容が不明瞭で申し訳ありません。
ご教示頂いたVBAや関数を悪戦苦闘して検証しております。。。

補足を入れさせて頂きました。
ご参照頂けると有難いです。

回答No.2

f272

あなたが手作業でやれるのであれば，それはVBAを使ってもできます。
手作業でやるとすればどうするのかを書いてもらえば，親切な人がコードを作ってくれるかもしれません。

お礼

早々にご回答頂きまして有難うございました。

回答No.1

m5048172715

できる。私はエクセルの関数をよく知らないけど、VBAなら書けたので、VBAでやってた。

まず任意の（ブック、シート、）セルを読み書きできる関数を作ればこっちのもので、あとは文字でも数字でも（単純な図形でも）VBAで処理できる。エクセルの見にくい1行の式より、エディタで見やすいコードのVBAの方がやりやすい。

そのときは、課税シートというのを用意して、そこに課税非課税の一覧を作り、VBAで処理するとき随時課税シートを参照することになるだろう。VBAのコードに課税項目を盛り込むと、オペレーターが修正や追加できないっぽい。

お礼

早々にご回答頂きまして有難うございました。