エクセルVBAについておねがいします。

エクセルマクロで下のように総量から最大200gずつに仕分けて、
さらにメーカーにおいても仕分けたいのですが、うまくいきませんでした。

メーカー　　品名　　　総量
F　 　　頭痛薬 　　600g
F　　　　胃腸薬 　350g
T 　　風邪薬 　400g
T 　　目薬　 　200g
Y 　　痛み止め　　200g
↓
↓
↓200gずつ、メーカーによって仕分ける
↓
F　　　　　　　　　T　　　　　　　　　Y
頭痛薬　200g　　 風邪薬　200g　　痛み止め　200ｇ
頭痛薬 200g　　　風邪薬　200g
頭痛薬 200g　　　目薬　　200ｇ
胃腸薬　200g
胃腸薬　150g

前回もいろいろと教えていただいたのですが、またどなたか教えていただけませんか？

No.1 回答者： maslkjh 回答日時： 2008/03/19 18:31

このような問題は見た目より随分手間のかかる問題です。

このような問題が多発するようでしたらＳＱＬなどのデータベースの導入をお勧めします。いずれにせよ一筋縄ではいきませんが。

No.2 ベストアンサー 回答者： fumufumu_2006 回答日時： 2008/03/20 09:03

こんなのではどうでしょうか？

Option Explicit

Sub test()
Dim ss As Worksheet
Dim ds As Worksheet
Dim sr As Long
Dim sc As Integer
Dim dr As Integer
Dim dc As Integer
Dim v As Integer
Dim s As String
Dim d() As String
Set ss = Sheets("sheet1") '元シート
Set ds = Sheets("sheet2") '出力シート
ds.Cells.Clear

'メーカー抽出(重複削除)
'vbNullCharはセパレータで何でもいい（カンマなど)
For sr = 2 To ss.Cells(ss.Rows.Count, 1).End(xlUp).Row
If InStr(vbNullChar & s, vbNullChar & ss.Cells(sr, 1).Value & vbNullChar) = 0 Then
s = s & ss.Cells(sr, 1).Value & vbNullChar
End If
Next

'メーカー名をdsへ
s = Replace(s, vbNullChar, vbNullChar & vbNullChar) '1行空けるために
d = Split(s, vbNullChar)
ds.Cells(1, 1).Resize(1, UBound(d)) = d

'dsの各行のデータを設定
For sr = 2 To ss.Cells(ss.Rows.Count, 1).End(xlUp).Row
dc = WorksheetFunction.Match(ss.Cells(sr, 1), ds.Cells(1, 1).Resize(1, UBound(d)), 0) '列を取得するのにmatch関数を使用
dr = ds.Cells(ds.Rows.Count, dc).End(xlUp).Row + 1
'v = ss.Cells(sr, 3)
v = Val(ss.Cells(sr, 3)) '総量にg(グラム）がついている（文字）の場合
Do
ds.Cells(dr, dc) = ss.Cells(sr, 2)
If v > 200 Then
ds.Cells(dr, dc + 1) = 200
'ds.Cells(dr, dc + 1) = "200g" 'g(グラム）をつける場合
v = v - 200
dr = dr + 1
Else
ds.Cells(dr, dc + 1) = v
'ds.Cells(dr, dc + 1) = v & "g" 'g(グラム）をつける場合
Exit Do
End If
Loop
Next
End Sub

この回答へのお礼

回答ありがとうございました。
まだVBA初心者ですので、上記のコードを参考に作ってみたら
できました。
どうもありがとうございました。

お礼日時：2008/03/28 14:51