[[20250429111533]]　『マクロで、範囲を指定し、全体的に移動させたい。』（ひまぞう）　ページの最後に飛ぶ

『マクロで、範囲を指定し、全体的に移動させたい。』（ひまぞう）

下記でつまずいており、ご教示いただけますと幸いです。

ルール
・移動範囲：C列からの数値のみ（最後列と最後行は、都度変動）
・A列とB列の2つの条件で開始行を検索
・移動指示数が1の場合、1行下に範囲全体を移動
・余白となった開始行は0と入力
・処理方法は、1指示1処理で完了（次は、逆移動を交え複数指示をしたいため）

悩み
複数指示実行時、最下行の累積管理で計3行となるべきが、2行しか表示されません。

使用シート
1.「指示」シート
日付区分移動数
2025/3/1　A 1
2025/3/2　A 2

2.「集計」シート」
日付区分品番1 品番2 試作
2025/3/1　A 20 40 0
2025/3/1　B 20 40 0
2025/3/1　C 20 40 0
2025/3/2　A 20 40 10
2025/3/2　B 20 40 0
2025/3/2　C 20 40 0

◇指示が、2025/3/1　A　1　の場合
・移動　C2:E7→C3:E8
・移動後の開始行に0入力　C2:E2

日付区分品番1 品番2 試作
2025/3/1　A 0 0 0
2025/3/1　B 20 40 0
2025/3/1　C 20 40 0
2025/3/2　A 20 40 0
2025/3/2　B 20 40 10
2025/3/2　C 20 40 0
　　　　 20 40 0

◇指示が、複数の場合、2025/3/1　A　1と、2025/3/2　A　2
日付区分品番1 品番2 試作
2025/3/1　A 0 0 0
2025/3/1　B 20 40 0
2025/3/1　C 20 40 0
2025/3/2　A 0 0 0
2025/3/2　B 0 0 0
2025/3/2　C 20 40 0

		20	40	10
		20	40	0
		20	40	0

＜使用 Excel：Excel2019、使用 OS：Windows11 ＞

 こういうことですか?

 Sub test()
    Dim c(1) As Range, r As Range, x
    Set c(0) = Sheets("指示").[a1].CurrentRegion.Offset(1)
    Set c(1) = Sheets("集計").[a1].CurrentRegion
    For Each r In c(0).Columns(1).Cells
        If r <> "" Then
            x = c(0).Parent.Evaluate("match(" & r.Address & "&""|""&" & _
                r(, 2).Address & "," & c(1).Columns(1).Address(, , , 1) & _
                "&""|""&" & c(1).Columns(2).Address(, , , 1) & ",0)")
            If IsNumeric(x) Then
                With c(1)(x, 3).Resize(r(, 3), 3)
                    .Insert xlShiftDown
                    .Offset(-r(, 3)).Value = 0
                End With
            End If
        End If
    Next
End Sub
（jindon） 2025/04/29(火) 13:39:15

jindonさん
ありがとうございます。
完璧です。こんな短時間で、凄いの一言です。

少々、配列や開始行、シート名は違うのですが、作成中のコードがなぜ正しく処理できないかを、ご教示いただくことはできますでしょうか。

使用シート
1.「スライド指示」シート
ヘッダー：7行目
指示行：8：16行目
日付タクトスライド数
2025/3/1　A 1
2025/3/2　A 2

2.「スライド調整後」シート」
ヘッダー：5行目
データ：6行目から
日付タクト納場　品番1 品番2 試作　（D列から数値）

このコードには、移動処理とは別に、戻し処理の2つの処理が入っております。
最終的には、この2つの処理を複数で同時に行いたいのですが、片方が出来ればその片方が崩れるのイタチごっこで悩んでおります。

ちなみに、戻しのルールは、指示数の入力をマイナスとし、開始行で下行を上詰めし合計。そして、範囲全体を上に移動となります。

◇戻し指示が、2025/3/2　A　-1　の場合

日付区分品番1 品番2 試作
2025/3/1　A 20 40 0
2025/3/1　B 20 40 0
2025/3/1　C 20 40 0
2025/3/2　A 40 80 10
2025/3/2　B 20 40 0
2025/3/2　C 20 40 0
2025/3/3　A 20 40 0
2025/3/3　B 0 0 0

Sub Slide_Both_Main()

    Dim ws指示 As Worksheet
    Dim ws調整後 As Worksheet
    Set ws指示 = Worksheets("スライド指示")
    Set ws調整後 = Worksheets("スライド調整後")

    Dim i As Long
    i = 8 ' 指示は8行目からスタート

    Do While ws指示.Cells(i, 1).Value <> ""
        Slide_OneShot i
        i = i + 1
    Loop

    ' すべての指示を処理した後、罫線を引き直す
    Dim 最終行 As Long, 最終列 As Long
    最終列 = ws調整後.Cells(6, Columns.count).End(xlToLeft).Column
    最終行 = ws調整後.Cells(ws調整後.Rows.count, 1).End(xlUp).Row

    With ws調整後.Range(ws調整後.Cells(7, 4), ws調整後.Cells(最終行, 最終列)).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With

    MsgBox "すべてのスライド指示が完了しました！", vbInformation

End Sub

Sub Slide_OneShot(i指示 As Long)

    Dim ws指示 As Worksheet, ws調整後 As Worksheet
    Set ws指示 = Worksheets("スライド指示")
    Set ws調整後 = Worksheets("スライド調整後")

    Dim j As Long, col As Long
    Dim 指示日 As Date, 指示タクト As String, スライド数 As Long
    Dim 最終行 As Long, 最終列 As Long, 対象行 As Long

    最終列 = ws調整後.Cells(6, Columns.count).End(xlToLeft).Column
    スライド数 = ws指示.Cells(i指示, 3).Value

    Dim tmp As Variant
    tmp = ws指示.Cells(i指示, 1).Value
    If IsDate(tmp) Then
        指示日 = CDate(tmp)
    Else
        MsgBox "指示日の形式が正しくありません。", vbExclamation
        Exit Sub
    End If

    指示タクト = ws指示.Cells(i指示, 2).Value

    最終行 = ws調整後.Cells(ws調整後.Rows.count, 1).End(xlUp).Row
    対象行 = 0

    For j = 6 To 最終行
        If ws調整後.Cells(j, 1).Value = 指示日 And ws調整後.Cells(j, 2).Value = 指示タクト Then
            対象行 = j
            Exit For
        End If
    Next j

    If 対象行 = 0 Then Exit Sub

    If スライド数 > 0 Then
        ' --- 後ろ倒し ---
        Dim 移動データ As Variant
        移動データ = ws調整後.Range(ws調整後.Cells(対象行, 4), ws調整後.Cells(最終行, 最終列)).Value

        ws調整後.Range(ws調整後.Cells(対象行 + スライド数, 4), ws調整後.Cells(最終行 + スライド数, 最終列)).Value = 移動データ

        ws調整後.Range(ws調整後.Cells(対象行, 4), ws調整後.Cells(対象行 + スライド数 - 1, 最終列)).Value = 0

    ElseIf スライド数 < 0 Then
        ' --- 戻し ---
        Dim 合計配列() As Double
        ReDim 合計配列(1 To 最終列 - 3)

        Dim k As Long
        For k = 0 To Abs(スライド数)
            For col = 4 To 最終列
                合計配列(col - 3) = 合計配列(col - 3) + ws調整後.Cells(対象行 + k, col).Value
            Next col
        Next k

        For col = 4 To 最終列
            ws調整後.Cells(対象行, col).Value = 合計配列(col - 3)
        Next col

        For k = 1 To Abs(スライド数)
            For col = 4 To 最終列
                ws調整後.Cells(対象行 + k, col).ClearContents
            Next col
        Next k

        Dim 詰め行差 As Long: 詰め行差 = Abs(スライド数)
        Dim 最終データ行 As Long
        最終データ行 = ws調整後.Cells(ws調整後.Rows.count, 1).End(xlUp).Row

        For j = 対象行 + 詰め行差 + 1 To 最終データ行
            For col = 4 To 最終列
                ws調整後.Cells(j - 詰め行差, col).Value = ws調整後.Cells(j, col).Value
                ws調整後.Cells(j, col).ClearContents
            Next col
        Next j

    End If

End Sub

（ひまぞう） 2025/04/29(火) 14:48:49

 >ちなみに、戻しのルールは、指示数の入力をマイナスとし、開始行で下行を上詰めし合計。そして、範囲全体を上に移動となります

 もし開始行で既に調整がある場合ですか?
 即ち、開始行から指定行数の値が全て0の場合のみ実行ですか?

 ここが理解できません。
（jindon） 2025/04/29(火) 15:56:00

開始行には整数がありますので、開始行の値+指定行数の値となり、合計値を開始行に表示したいです。
よろしくお願いいたします。
（ひまぞう） 2025/04/29(火) 16:18:29

イメージは下記となります。

指示
・2025/3/1 A 2
・2025/3/2 A -2

日付タクト品番1 品番2 試作
2025/3/1 A 0 0
2025/3/1 B 0 0
2025/3/1 C 20 40
2025/3/1 D 20 40
2025/3/2 A 60 120
2025/3/2 B 20 40
2025/3/2 C 20 40 10
2025/3/2 D 20 40

		0	0	
		0	0

（ひまぞう） 2025/04/29(火) 16:26:10

 少々混乱しています。

 2025/3/1 D 20 40
 2025/3/2 D 20 40
 が2行追加されていますが、間違いないですか?

 もし間違いなければその理由を説明してください。

（jindon） 2025/04/29(火) 17:11:07

すみません。Dも間違えではございません。
元々、1日のタクトがA,B,C,Dまであります。
初めは説明を簡素化するために、A～Cでお伝え致しました。
ならびに、他社ではこの区分が、1～24の数字での表記もあります。
お手数をお掛けいたしますが、よろしくお願いいたします。
（ひまぞう） 2025/04/29(火) 17:44:03

 >2025/04/29(火) 14:48:49 
 のひまぞうさんの表にはDがありません。

 どのような理由で2025/04/29(火) 16:26:10の表でdが追加されるのわかりません。

 あくまでも、同じ表が結果の表に変換されるのですよね?

 そうでなければ、ちんぷんかんぷんになりますよ?
（jindon） 2025/04/29(火) 17:57:42

逆に複雑にしてしまい申し訳ございません。
はい。同じ表が結果の表として変換されます。
よろしくお願いいたします。
（ひまぞう） 2025/04/29(火) 18:29:10

 ですから、変換の過程で追加するならその条件の説明が無ければ無理です。

 2025/04/29(火) 14:48:49で提示された表がどのようにして2025/04/29(火) 16:26:10の表に変換するのか
 詳しく説明してください。

 1) 2025/3/1　A 1
 の場合どのようにならなければならないのか

 2) 2025/3/2 A -2
 の場合

 3) どの段階でDの行が挿入されるのか。

 等々...
（jindon） 2025/04/29(火) 18:40:01

何度もすみません。
現在作成中のシート内容で、再度ご説明させてください。

1つのブックに使用するマクロは2つあります。
・マクロ1は作成済
・今回マクロ2を作成したいと考えております。

マクロ処理
・マクロ1は、加工前データとして「スライド調整後」シートに展開。
・加工前データをそのまま使用し、マクロ2で「スライド指示」を実行し「スライド調整後」シートの加工前データを変更。

 ・どの段階でDの行が挿入されるのか。

　データはすべて、マクロ1が実行された初めの時点となります。（途中から追加する事はございません）

マクロ1実行後

「スライド調整後」シート

加工前データ
日付タクト納場 A1 A2 A3 A4 A5 試作
2025/3/1　A A80 20 30 40 50 60 0
2025/3/1　B A80 20 30 40 50 60 0
2025/3/1　C A80 20 30 40 50 60 0
2025/3/1　D A80 20 30 40 50 60 0
2025/3/2　A A80 20 30 40 50 60 0
2025/3/2　B A80 20 30 40 50 60 0
2025/3/2　C A80 20 30 40 50 60 0
2025/3/2　D A80 20 30 40 50 60 0

マクロ2実行後

　1）2025/3/1　A 1　の場合
・対象行のD列から最後列の数値を全体的に1行下げる。
・対象行のD列から最後列に0入力

日付タクト納場 A1 A2 A3 A4 A5 試作
2025/3/1　A A80 0 0 0 0 0 0
2025/3/1　B A80 20 30 40 50 60 0
2025/3/1　C A80 20 30 40 50 60 0
2025/3/1　D A80 20 30 40 50 60 0
2025/3/2　A A80 20 30 40 50 60 0
2025/3/2　B A80 20 30 40 50 60 0
2025/3/2　C A80 20 30 40 50 60 0
2025/3/2　D A80 20 30 40 50 60 0

			20	30	40	50	60	0

 　2) 2025/3/2 A -2　の場合
・対象行で合計処理（合計は計3行）（対象行+下2行）
・合計後、最下行から2行詰め上げ（ブランクとなった最後行はそのままクリア）

日付タクト納場 A1 A2 A3 A4 A5 試作
2025/3/1　A A80 20 30 40 50 60 0
2025/3/1　B A80 20 30 40 50 60 0
2025/3/1　C A80 20 30 40 50 60 0
2025/3/1　D A80 20 30 40 50 60 0
2025/3/2　A A80 60 90 120 150 180 0
2025/3/2　B A80 20 30 40 50 60 0
2025/3/2　C A80
2025/3/2　D A80

 3) 複数指示、1と-2の場合（2025/3/1 A 1,2025/3/2 A -2)

日付タクト納場 A1 A2 A3 A4 A5 試作
2025/3/1　A A80 0 0 0 0 0 0
2025/3/1　B A80 20 30 40 50 60 0
2025/3/1　C A80 20 30 40 50 60 0
2025/3/1　D A80 20 30 40 50 60 0
2025/3/2　A A80 60 90 120 150 180 0
2025/3/2　B A80 20 30 40 50 60 0
2025/3/2　C A80 20 30 40 50 60 0
2025/3/2　D A80

3) 複数指示、2と-2の場合（2025/3/1 A 2,2025/3/2 A -2)

日付タクト納場 A1 A2 A3 A4 A5 試作
2025/3/1　A A80 0 0 0 0 0 0
2025/3/1　B A80 0 0 0 0 0 0
2025/3/1　C A80 20 30 40 50 60 0
2025/3/1　D A80 20 30 40 50 60 0
2025/3/2　A A80 60 90 120 150 180 0
2025/3/2　B A80 20 30 40 50 60 0
2025/3/2　C A80 20 30 40 50 60 0
2025/3/2　D A80 20 30 40 50 60 0

（ひまぞう） 2025/04/29(火) 20:25:14

 有難うございます。
 全て理解できました。

 以下で試してください。
 もし全てのケースでの結果が良ければ、コードに付いて知りたい部分があれば質問してください。

 私は、質問が無ければ全て理解したものと判断しますので。

 Sub test()
    Dim c(1) As Range, r As Range, x, i&, mySum#(), t&
    Set c(0) = Sheets("スライド指示").[a7].CurrentRegion.Offset(1)
    Set c(1) = Sheets("スライド調整後").[a5].CurrentRegion
    t = c(1).Columns.Columns.Count - 3
    ReDim mySum(1 To t)
    For Each r In c(0).Columns(1).Cells
        If r <> "" Then
            x = c(0).Parent.Evaluate("match(" & r.Address & "&""|""&" & _
                r(, 2).Address & "," & c(1).Columns(1).Address(, , , 1) & _
                "&""|""&" & c(1).Columns(2).Address(, , , 1) & ",0)")
            If IsNumeric(x) Then
                If r(, 3) > 0 Then
                    With c(1)(x, 4).Resize(r(, 3), t)
                        .Insert xlShiftDown
                        .Offset(-r(, 3)).Value = 0
                    End With
                Else
                    For i = 1 To t
                        mySum(i) = Application.Sum(c(1)(x, i + 3).Resize(Abs(r(, 3)) + 1))
                    Next
                    c(1)(x, 4).Resize(, t) = mySum
                    c(1)(x + 1, 4).Resize(Abs(r(, 3)), t).Delete xlShiftUp
                End If
            End If
        End If
    Next
End Sub
（jindon） 2025/04/29(火) 21:06:05

jindonさん
ありがとうございます。
この短時間で本当に凄いです。
イメージ通りに完成されています。

作っていただいたコードを拝見し、とてもシンプルで驚きました。特に、データの検索とか行の操作、あと戻し処理の後の詰め込みが、あんなに簡単にできるなんてビックリでした。

ただ、一つだけ追加のお願いがありまして…
処理後に、対象行のみJ列に「0」が入力されるようになっています。もし可能でしたら、この処理を見直して頂くことはできますでしょうか。
（ひまぞう） 2025/04/30(水) 09:53:00

 期待通りの動作を確認できほっとしました。

 >対象行のみJ列に「0」が入力されるようになっています。
 こちらでは再現できませんので、おそらくCurrentRegionの範囲がJ列まで取得されているのでしょう。

 2行挿入してください。

    Set c(1) = Sheets("スライド調整後").[a5].CurrentRegion
    x = c(1).Parent.Evaluate(Replace("max(if(#=""試作"",column(#)))", "#", c(1).Address))  '<---1
    Set c(1) = c(1).Resize(, x)                                                            '<---2
    t = c(1).Columns.Columns.Count - 3

 "試作"を探してその列までで限定します。
（jindon） 2025/04/30(水) 10:35:13

jindonさん
返信ありがとうございます。
上記コードを追加し試しましたが、まだ「0」が表示されます。
（ひまぞう） 2025/04/30(水) 11:36:02

 不思議です。

 こちらで試したのはJ4に何かしらの値（スペースとか)を入力して確認しましたがOKでした。
 もしかしたら 他の[試作] がCurrentRegionの他行のＪ列に存在しているとしか考えられません。

 範囲をA:I に決め打ちで良いのなら
 挿入した2行を削除して

 Set c(1) = Sheets("スライド調整後").[a5].CurrentRegion
 を
 Set c(1) = Sheets("スライド調整後").[a5].CurrentRegion.Resize(, 9)
 に変更してください。
（jindon） 2025/04/30(水) 12:28:09

jindonさん
原因が分かりました。
J2セルの文章を、G2へ移動したら、「0」入力がなくなりました。
これで完結です。
期待通りのマクロが出来ました。。

また何かあったら頼らせてもらうかもしれませんが、その時はぜひ力を貸してください。
改めて、この度はありがとうございました。
（ひまぞう） 2025/04/30(水) 14:42:34

コメント返信：

[ 一覧(最新更新順) ]

[[20250429111533]] 『マクロで、範囲を指定し、全体的に移動させたい。』（ひまぞう） ページの最後に飛ぶ

[[20250429111533]]　『マクロで、範囲を指定し、全体的に移動させたい。』（ひまぞう）　ページの最後に飛ぶ