エクセル ＶＢＡ 教えてください

ＶＢＡ初心者です。

どなたか教えてください。

先日も同じような質問をさせていただき、かなり理想に近い回答を
いただきましたが、自力では
どうしても解決に至らず再度投稿させていただきました。


下記の様な表があります。

[やりたいこと]
①Ａ列を最初にみて、文字列の　”０”　ｏｒ　”02”　を判断します

②Ａ列が2であれば、となりのセルＢ列をみます
　Ａ列が1であれば上に次に進む

③Ｂ列の数字の分だけ　その下に行を追加し
　追加した行には、同じ内容をコピーします。

④さらに③で増やした行の個数は、1へ変更し元の行も
　1へ変更します。

⑤ Ｄ列の重量は按分させ、最後の部分でＲＯＵＮＤダウン
　　させたいです。　　


⑤最後に処理完了のメッセージＢＯＸ

[結果]　表1を　表2の様な形にしたいです。

表1
業者 個数 記事 重量
2 　4 　A 　8
2 　3 　B 　9
2 　2 　C 　10
1 　1 　D 　4
2 　1 　E 　6
1 　2 　F 　3
2 　5 　G 　15



表2
業者 個数 記事 重量
2 　1 　A 　2
2 　1 　A 　2
2 　1 　A 　2
2 　1 　A 　2
2 　1 　B 　3
2 　1 　B 　3
2 　1 　B 　3
2 　1 　C 　5
2 　1 　C 　5
1 　1 　D 　4
2 　1 　E 　4
1 　2 　F 　10
2 　1 　G 　3
2 　1 　G 　3
2 　1 　G 　3
2 　1 　G 　3
2 　1 　G 　3


どうかお願いいたします。

質問者からの補足コメント

• ハイスコアーさん
  ありがとうございます。
  
  
  下記が前回の回答のアドレスです。
  
  https://oshiete.goo.ne.jp/mypage/history/questio …
  
  ○前回との変更点は
  
  ①Ｄ列に、重量を追加
  
  上記です。
  
  どうかお願いいたします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2015/04/02 07:08

• WindFaller さん
  
  ご教示ありがとうございます。
  失礼いたしました、　
  
  ①6行目　7行目は　当方の誤りです。※ご指摘の通り　そのままかわらないのが正当です。
  
  ②A列の表記については、　半角・文字列　となり　2の前には　0があり　表記は　”02”と
  　なっております。
  
  
  余計わかりずらくさせてしまい申し訳ございません。
  
  何卒よろしくお願いいたします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2015/04/02 11:24

No.4 ベストアンサー 回答者： tatsu99 回答日時： 2015/04/03 11:11

確認事項１

＞①Ａ列を最初にみて、文字列の　”０”　ｏｒ　”02”　を判断します
＞②Ａ列が2であれば、となりのセルＢ列をみます
＞　Ａ列が1であれば上に次に進む
上記の①と②は、つじつまが合いません。
①Ａ列を最初にみて、文字列の　”１”　ｏｒ　”2”　を判断します
と解釈します。

確認事項２
＞⑤ Ｄ列の重量は按分させ、最後の部分でＲＯＵＮＤダウンさせたいです。　
重量８を4個で按分すると、２，２，２，２で問題ないですが、
重量６を4個で按分すると、２，２，２，０でしょうか？　・・・A案
それとも
重量６を4個で按分すると、２，２，１，１でしょうか？　・・・B案
とりあえず、B案と解釈します。

前回、tom04さんが回答されたソースに手を加えました。
--------------------------------------------------------------
Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Dim amari As Long
Dim sho As Long
Dim juuryo As Long
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
.Range("A:D").ClearContents
wS.Range("A1:D1").Copy .Range("A1")
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
cnt = 0
If wS.Cells(i, "A") = 2 Then
amari = wS.Cells(i, "D") Mod wS.Cells(i, "B")
sho = wS.Cells(i, "D") \ wS.Cells(i, "B")
Do Until cnt = wS.Cells(i, "B")
cnt = cnt + 1
With .Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Value = wS.Cells(i, "A")
.Offset(, 1) = 1
.Offset(, 2) = wS.Cells(i, "C")
juuryo = sho
If amari > 0 Then
juuryo = juuryo + 1
amari = amari - 1
End If
.Offset(, 3) = juuryo
End With
Loop
Else
.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 4).Value = wS.Cells(i, "A").Resize(, 4).Value
End If
Next i
.Activate
MsgBox "処理完了"
End With
End Sub

--------------------------------------------------------------

この回答へのお礼

tatsu99さん

ご連絡遅くなりもうしわけございません。

質問の趣旨をご理解いただき、的確な答えをいただきましたのでベストアンサーと
させていただきました。

ＶＢＡができる人ってホントにうらやましいです。

またおねがいいたします。

お礼日時：2015/04/05 20:34

No.3 回答者： WindFaller 回答日時： 2015/04/02 17:50

#2の回答者です。

お手数かけてすみません。分かりきったことのようでも、それ聞くのは、長い間に身についた作法みたいなものなのです。

>②A列の表記については、　半角・文字列　となり　2の前には　0があり　表記は　”02”となっております。
思わぬ所でややこしくなるものなのですね。以下のマクロは、あまり格好がよくないですね。それに、中途半端な配列変数を使ってしまいました。他の方のコードも待ってみましょう。

'//
Sub TestMacro1()
Dim Ar As Variant
Dim i As Long, j As Long, k As Long
Dim sh2 As Worksheet
Set sh2 = Worksheets("Sheet2") '出力はシート2
sh2.Cells(1, 1).Resize(, 4).Value = Array("業者", "個数", "記事", "重量")
k = 2
With Range("A1").CurrentRegion
　Ar = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Value
End With
For i = 1 To UBound(Ar)
　If Ar(i, 1) Like "0" Or Ar(i, 1) Like "02" Then
　 For j = 1 To Ar(i, 2)
　　With sh2
　　　.Cells(k, 1).Value = "'" & Ar(i, 1)
　　　.Cells(k, 2).Value = 1
　　　.Cells(k, 3).Value = Ar(i, 3)
　　　.Cells(k, 4).Value = Int(Ar(i, 4) / Ar(i, 2))
　　End With
　　　k = k + 1
　 Next
　Else
　　With sh2
　　　.Cells(k, 1).Value = "'" & Ar(i, 1)
　　　.Cells(k, 2).Value = Ar(i, 2)
　　　.Cells(k, 3).Value = Ar(i, 3)
　　　.Cells(k, 4).Value = Ar(i, 4)
　　End With
　　 k = k + 1
　End If
Next
MsgBox "元" & UBound(Ar) & "行を" & k - 1 & "行に展開しました。", vbInformation
End Sub
'//

No.2 回答者： WindFaller 回答日時： 2015/04/02 10:40

こんにちは。

表１の6行目と7行目は

2 　1 　E 　6
1 　2 　F 　3
　　　↓
表2
2 　1 　E 　4
1 　2 　F 　10

になる仕組みを教えてください。
私は、そのまま変わらないと思っていました。

それと、
>①Ａ列を最初にみて、文字列の　”０”　ｏｒ　”02”　を判断します
この表記自体は、最初は、全角の「0」を使っていらっしゃるようですし、
「02」は、Excel上では、文字列ではなく、書式で表示するのが一般的かと思います。この状況下では、文字列比較をするのは、Text Compare モードでも、収まらない可能性があります。

No.1 回答者： High_Score 回答日時： 2015/04/02 06:44

前回の理想に近い回答はどんな内容ですか？

前回との変更点はどこですか？