条件にあうデータ抽出のやりかたについて

質問

エクセルＶＢＡの初心者です。現在エクセルを使って次のような顧客リストを作っています。

　ＩＤ　氏名　商品Ａ　入金　商品Ｂ　入金
　１　　ＡＡ　55円　　済　　65円　　未　
　２　　ＢＢ　66円　　未　　85円　　未
　３　　ＣＣ　41円　　未　　32円　　済
このようなリストからＶＢＡを使って、次のような集計表を自動作成したいと試行錯誤しています。
　未納者一覧
　ＩＤ　氏名　商品名　単価　入金状況
　　１　ＡＡ　商品Ｂ　65円　未
　　２　ＢＢ　商品Ａ　66円　未
　　　　　　　商品Ｂ　85円　未
　　３　ＣＣ　商品Ａ　41円　未
自分なりに入門書を片手にいろいろと試しては見たのですが、なかなかうまく行きません。どなたかご指導願えないでしょうか。
なお、現在の顧客データは150名ほど入力しています。
商品の種類は23種類です。

回答No.1

imogasi · ベストアンサー

（例データ）
氏名 商品Ａ 入金 商品Ｂ 入金 商品Ｃ 入金
中井 55円 済 65円 未
高井 66円 未 85円 未
上井 41円 未 32円 済 33円 未
高井 16円 未 21円 未
大川 9円 未 74円 済 75円 未
高井 34円 未 127円 未
杉井 35円 済 128円 未
（ＶＢＡ）
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
'----A
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
'-----B
d = sh1.Range("A2").CurrentRegion.Rows.Count
' MsgBox d
k = 1
For i = 2 To d
For j = 3 To 20 Step 2
If sh1.Cells(i, j) = "未" Then
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(1, j - 1)
sh2.Cells(k, "C") = sh1.Cells(i, j - 1)
sh2.Cells(k, "D") = sh1.Cells(i, j)
k = k + 1
End If
Next j
Next i
'-------
sh2.Range(Cells(1, 1), Cells(k - 1, 4)).Select
Selection.Sort Key1:=sh2.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End Sub
（結果）
高井 商品Ａ 66円 未
高井 商品Ｂ 85円 未
高井 商品Ａ 16円 未
高井 商品Ｂ 21円 未
高井 商品Ａ 34円 未
高井 商品Ｂ 127円 未
上井 商品Ａ 41円 未
上井 商品Ｃ 33円 未
杉井 商品Ｂ 128円 未
大川 商品Ａ 9円 未
大川 商品Ｃ 75円 未
中井 商品Ｂ 65円 未
ソート後名前が前行と同じとき空白は、判るだろうと手抜き。
・For j = 3 To 20 Step 2は3,5,7,・・19の９列を
Ｍａｘに考えてますが適当に修正を。
・d = sh1.Range("A2").・・やFor i = 2 To d
は実際に合わせて適当に。

お礼

丁寧なサンプルまでつけていただき感謝します。
おかげさまで何とか解決できそうです。本当にありがとうございました。