質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.79%

VBA 行の挿入に関して

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 545

QueCho

score 13

前提・実現したいこと

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

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

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

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

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

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

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

該当のソースコード

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

```

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3

check解決した方法

0

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

コードの細かいところは読んでませんが、
行を挿入する場合、挿入以降の行は下にずれます、当然、最終行も下にどんどんずれていきます。
それを考慮する必要がありますが、提示のコードでは最初に取得した最終行(rmax)が固定のままです。

通常、行を挿入しながらループ処理する場合は、
For Next を使うなら最終行から上に向かってループ処理する、
あるいは Do Loop で下に向かって処理していき、カレント行の値が未入力になったら終了、
というロジックにします。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/04/15 14:26

    回答していただきありがとうございます。For Nextを用いて最終行から上に向かってループ処理してみます。

    キャンセル

0

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


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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/04/15 14:31

    回答していただきありがとうございます。
    As Longについては記載ミスです。申し訳ありません。
    追加した分rmaxを増やす際にこの場合iの処理1回につき2行増えると思うのですが
    一般的にどのように記述するのでしょうか?

    キャンセル

  • 2019/04/15 14:44

    一般的と言うか...VBAはやり方一つしかないよ。
    rmax = rmax + 1
    これで+1だから、+2はどのように記載するでしょう?

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.79%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る