VBA　行の挿入に関して

前提・実現したいこと

各商品の出庫と入庫の下にそれぞれ金額行を作成し、
一番下に出庫と入庫の各合計金額行を作成し、
値を入れるマクロを作成したいです。

B3:AJ55までの1か月分の入出庫状況のテーブルが存在していて、
B列：型番名
C列：商品名
D列：入出庫の各単価
E列：各商品3行ずつで区切られていてE５＝入庫、E6＝出庫、E7=在庫を以下ループ
F列：E列に対応した先月繰越
G列～AI列：日にちごとの入庫・出庫・在庫数
AJ列：1月分各行合計

3行：日付
4行：項目　G列以降は曜日
5行：B、C列は型番、商品名　以下入庫に関する値
6行：D列以降出庫に関する値
7行：E列以降在庫に関する値

以降5～７行の内容をを型番・商品名・単価等を変えて繰り返し
商品数は17

わかりづらいと思いますが宜しくお願い致します。

発生している問題・エラーメッセージ

出庫と入庫の下にそれぞれ金額行を挿入するところで躓いています。
１つ目の商品の場合、新たに6，8行目に挿入したいです。

該当のソースコード

Sub 問題()

Dim i As Long, j As Long, k As Long ' カウンタ
Dim buf(100, 100) As String

Dim cmax, rmax As Long
cmax = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
rmax = ws1.Cells(Rows.Count, 1).End(xlUp).Row


' 行の挿入 転記
For i = 7 To rmax Step 5
    
    '行の挿入
    Rows(i).Insert
    
    ' セルの値を代入
    For k = 6 To cmax + 1
        buf(i + 1, k) = Cells(i + 1, k).Formula
        Cells(i + 1, k).Select
    Next
    
    ' 行の挿入
    Rows(i).Insert
    
    ' セルに値を代入
    Cells(i + 1, 5).Value = Cells(i + 2, 5).Value
    For k = 6 To rmax + 1
        Cells(i + 1, k).Select
        Cells(i + 1, k).Formula = buf(i + 1, k)
    Next
    
    ' セルの値を削除
    Range(Cells(i + 2, 5), Cells(i + 2, rmax + 1)).ClearContents
    
    ' セルの値と数式代入
    Cells(i, 5).Value = "金額"
    Cells(i + 2, 5).Value = "合計"
    For k = 6 To rmax
        Cells(i, k).Value = _
            Cells(i - 1, 4).Value * Cells(i - 1, k).Value
        Cells(i + 2, k).Value = _
            Cells(i - 1, 4).Value * Cells(i - 1, k).Value _
            - Cells(i - 2, 4).Value * Cells(i - 2, k).Value
    Next
Next

End Sub

行動規範の内容に同意します

回答3件

自己解決

Dim i As Long, j As Long, k As Long ' カウント
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1") '別紙①
Set ws2 = Worksheets("sheet2") '商品情報

Dim cmax, rmax As Long
cmax = ws1.Cells(5, Columns.Count).End(xlToLeft).Column
rmax = ws1.Cells(Rows.Count, 7).End(xlUp).Row


' 行の挿入 転記
For i = rmax To 7 Step -3
If Cells(i, 5).Value = "在庫" Then
    '行の挿入
    Rows(i).Insert
    
    rmax = rmax + 1
End If
    
If Cells(i - 1, 5).Value = "出庫" Then
    Rows(i - 1).Insert
    rmax = rmax + 1
End If

    ' セル値を代入
    For k = 6 To cmax
        Cells(i + 1, k).Value = Cells(i, 4) * Cells(i, k)
    Next k
    
    ' セル値を代入
    For k = 6 To cmax
        Cells(i - 1, k).Value = Cells(i - 2, 4) * Cells(i - 2, k)
    Next k
    
   ' セルの値と数式代入
    Cells(i + 1, 5).Value = "出庫金額"
    Cells(i - 1, 5).Value = "入庫金額"

Next i

End Sub

投稿2019/04/15 06:29

QueCho

総合スコア13

VBA
1Dim cmax, rmax As Long
2cmax = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
3rmax = ws1.Cells(Rows.Count, 1).End(xlUp).Row
4
5' 行の挿入 転記
6For i = 7 To rmax Step 5

ここのプログラムですが知っておきたいVBAの基礎的な知識が身に付いていません。
Dim cmax, rmax As LongではなくDim cmax As Long, rmax As Longと書かないとcmaxはLong型ではなく正確にはVariant型になっています。

後はhatena19さんの言われている通り、セルに追加するのは危険がいっぱいです。
追加した分rmaxを増やすか、2次元配列で一時的に別の空間に確保してからシートを全消ししてから書き直すという方法に変えて下さい。

投稿2019/04/15 05:07