- ベストアンサー
EXCEL VBAでの行コピー、分割の方法について教えてください
- EXCEL VBAを使用して、特定の条件を満たす行をコピー（挿入）し、さらに（数量）を分割する方法について教えてください。
- 具体的には、（数量）＞（マスタ）の場合に（数量）/（マスタ）分を行コピー（挿入）し、さらにＢ列の（数量）も（マスタ）以下になるように分割する方法について教えていただきたいです。
- 初心者ですので、具体的なコードや手順を教えていただけると助かります。
- wwwexcel01
- お礼率16% (1/6)
- オフィス系ソフト
- 回答数3
- ありがとう数7
- みんなの回答 （3）
- 専門家の回答
質問者が選んだベストアンサー
淡々と，やるべき事をやってみます。 Sub macro1() Dim h As Range Set h = Range("A1") Do Until h = "" If h.Offset(0, 1) > h.Offset(0, 2) Then ’多ければ h.EntireRow.Copy h.Offset(1).Insert ’行を挿入して h.Offset(0, 1) = h.Offset(0, 2) ’数量をマスタ量にして h.Offset(1, 1) = h.Offset(1, 1) - h.Offset(0, 1) ’挿入した行はその分減らす End If Set h = h.Offset(1) Loop Application.CutCopyMode = False End Sub
その他の回答 (2)
- layy
- ベストアンサー率23% (292/1222)
こちらは一旦締めきりのが良いです。
- Wendy02
- ベストアンサー率57% (3570/6232)
A2から実際にデータが始まるものとします。違う場合は、起点の部分を書き換えてください。 位置の変更がある場合でも、起点だけで済むはずです。 '// Sub TestMacro1() Dim rng As Range Dim EndRow As Long Dim i As Long, j As Long, n As Long, k As Long Dim buf As Variant Dim Ar() As Variant With ActiveSheet '(タイトル行を含む)起点はここに書きます。"A1" -> "A" Set rng = .Range("A1", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 4) End With With rng EndRow = .Rows.Count For i = 2 To EndRow k = .Cells(i, 2).Value / .Cells(i, 3).Value If k > 1 Then buf = .Cells(i, 2).Value For j = 0 To Int(k + 0.5) - 1 ReDim Preserve Ar(3, n) Ar(0, n) = .Cells(i, 1).Value If buf > .Cells(i, 3).Value Then Ar(1, n) = .Cells(i, 3).Value Else Ar(1, n) = buf End If Ar(2, n) = .Cells(i, 3).Value Ar(3, n) = Ar(2, n) / .Cells(i, 3).Value n = n + 1 buf = buf - .Cells(i, 3).Value Next Else ReDim Preserve Ar(3, n) Ar(0, n) = .Cells(i, 1).Value Ar(1, n) = .Cells(i, 2).Value Ar(2, n) = .Cells(i, 3).Value Ar(3, n) = .Cells(i, 2).Value / .Cells(i, 3).Value n = n + 1 End If Next .Range("A2").Resize(UBound(Ar, 2) + 1, 4).Value = Application.Transpose(Ar) End With Set rng = Nothing End Sub
