ようこそ ゲスト さん、新規登録（無料）して気になる疑問を解決しませんか？
はじめての方へ｜ヘルプ｜FAQ
スポンサーサイト（詳細）

質問
質問者：kenta11 エクセル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

前回もいろいろと教えていただいたのですが、またどなたか教えていただけませんか？
質問投稿日時：08/03/19 13:12
質問番号：3876050
この質問に対する回答は締め切られました。
最新から表示｜回答順に表示｜良回答のみ表示

回答

良回答20pt
回答者：fumufumu_2006 こんなのではどうでしょうか？

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
種類：アドバイス
どんな人：一般人
自信：参考意見
回答日時：08/03/20 09:03
回答番号：No.2
この回答へのお礼回答ありがとうございました。
まだVBA初心者ですので、上記のコードを参考に作ってみたら
できました。
どうもありがとうございました。

回答

良回答10pt
回答者：maslkjh このような問題は見た目より随分手間のかかる問題です。このような問題が多発するようでしたらＳＱＬなどのデータベースの導入をお勧めします。いずれにせよ一筋縄ではいきませんが。
種類：アドバイス
どんな人：一般人
自信：参考意見
回答日時：08/03/19 18:31
回答番号：No.1
この回答へのお礼この回答にお礼をつける(質問者のみ)
 
最新から表示｜回答順に表示｜良回答のみ表示
スポンサーサイト（詳細）
このページのトップへ