[[20230307220120]]　『マクロで高速で行挿入して同じ値を複数行増産した』（くらら）　ページの最後に飛ぶ

『マクロで高速で行挿入して同じ値を複数行増産したい』（くらら）

1行ずつの下記の表を、

     A    B    C      
  1 あ          a
  2 い          b
  3 う          c

下記のように3行ずつに増やしたいです。
マクロで高速にやる良い方法が知りたいです。
実際のデータは1,000行以上になるので、なるべく高速なやり方で考えたいです。

     A    B    C
  1 あ          a
  2 あ          a
  3 あ          a
  4 い          b
  5 い          b
  6 い          b
  7 う          c
  8 う          c
  9 う          c

 例えば、A列一列だけなら行挿入しないでも下記のようなイメージで割と速く処理できたのですが、C列も一緒に連動させたいので行を挿入しないとダメなのかなと思い苦戦中です。

A列だけの量産の場合…
元データのA列の数だけループして、
Cells(i, "A").Copy Destinations:= Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(3, 1)
のように別の列に増やすとかだと出来るのですが、、

良い方法あれば教えてください。

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

行の挿入とかするよりは、
D列に連番を振って、そのセルを下に一回個数分だけのセルにコピーして、
最後にD列の連番でソートしたほうが速いかもしれませんね。
この方法であれば、マクロでなくても手でできる範囲でしょう。

（abc） 2023/03/07(火) 22:48:35

abc様
ありがとうございます。
色々な方法がありますね！勉強になります。

今回は、一連の流れをマクロで実施したいので、引き続きマクロでの方法も何かありましたら
よろしくお願いします。
（くらら） 2023/03/07(火) 23:26:09

ああ、結構まじめにマクロの作成方法として提示したんですけどねえ。

それなら配列を使って作業するのが、速度の点では一番ですね。
・もとのセル範囲を配列にとりこみ、
・行を3倍した大きさの配列を Redimで作ります。
・それに、元の配列から一項目ずつ転記します。
・最後にシートに配列を一挙に書き込みます。
ヒントになりますか？
（abc） 2023/03/08(水) 00:03:01

abc様
すみません、最初にご提示頂いたのもマクロの作成方法だったのですね。
配列はまだ使ったことがなく、書いていただいた具体的なやり方が分からないので、
まずは連番振って並び替えの方法でチャレンジしてみます。
色々ありがとうございます。
（くらら） 2023/03/08(水) 06:10:09

おはようございます。＾＾
abcさんのご提案を基本に私なりに書いてみました。
あってるかなぁ～＾＾；
お試の際は、バックアップ必須となります。
読込先はSheet1
Ａ１～Ｃ任意の最終行、が処理対象です[項目名は無いものとしています。]
書込み対象シート[既定はSheet2です。]は初期化されます。
シートの存在確認、等々、エラー処理は御座いません。
という事で、使い物にはなりませんが、システム構築をご勘案の時
何かの参考にでもなれば幸甚です。
m(__)m

 Option Explicit
Sub OneInstanceMain()
    Dim v()           As Variant
    Dim w()           As Variant
    Dim tImeNum       As Long
    Dim sRcWsNm       As String
    Dim dEsWsNM       As String
    Dim aDrStr        As String
    Dim t             As Double
    t = Timer
    aDrStr = "A:C"
    sRcWsNm = "Sheet1"
    dEsWsNM = "Sheet2"
    tImeNum = 3
    Call wSRead(v, sRcWsNm, aDrStr)
    If tImeNum < 1 Or tImeNum * UBound(v, 1) > Rows.Count Then
        Erase v, w
        MsgBox "回数を減らしてください"
        Exit Sub
    End If
    Call dAtaChange(w, v, tImeNum)
    Call wSwrite(w, dEsWsNM)
    Erase v, w
   MsgBox "終了" & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _
                      Format((Timer - t) - Int(Timer - t), ".000") & " 秒"
End Sub
Sub wSRead(ByRef v() As Variant, ByVal wSnm As String, ByVal aStr As String)
    With Worksheets(wSnm)
        v = Intersect(.UsedRange, .Range(aStr)).Value
    End With
End Sub
Sub dAtaChange(ByRef w() As Variant, ByRef v() As Variant, ByVal tV As Long)
    Dim i             As Long
    Dim j             As Long
    Dim k             As Long
    Dim y             As Long
    ReDim w(1 To UBound(v, 1) * tV, 1 To UBound(v, 2))
    For i = 1 To UBound(v, 1)
        For j = 1 To tV
            y = y + 1
            If y Mod 12800 = 0 Then DoEvents
            For k = 1 To UBound(v, 2)
                w(y, k) = v(i, k)
            Next
        Next
    Next
End Sub
Sub wSwrite(ByRef w() As Variant, ByVal sNm As String)
    With Worksheets(sNm)
       .UsedRange.Clear
       .Cells(1).Resize(UBound(w, 1), UBound(w, 2)) = w
    End With
    Erase w
End Sub
（隠居Z） 2023/03/08(水) 08:36:11

 参考出品です

    Sub sample()
       Dim nRow As Long, i As Long, j As Long
       nRow = Cells(Rows.Count, "A").End(xlUp).Row
       For i = nRow To 1 Step -1
          Cells(i, "A").Resize(1, 3).Copy Destination:=Cells(i * 3 - 2, "A").Resize(3, 3)
       Next
    End Sub

    Sub sample2() ' 同じことを配列で
      Dim buf() As Variant
      Dim nRow As Long, i As Long, j As Long
      nRow = Cells(Rows.Count, "A").End(xlUp).Row
      buf() = Cells(1, 1).Resize(nRow * 3, 3).Value
      For i = nRow To 1 Step -1
          For j = 1 To 3
              buf(i * 3 - 2, j) = buf(i, j)
              buf(i * 3 - 1, j) = buf(i, j)
              buf(i * 3, j) = buf(i, j)
          Next
      Next
      Cells(1, 1).Resize(nRow * 3, 3).Value = buf()
    End Sub
（´・ω・`） 2023/03/08(水) 10:44:55

コメント返信：

[ 一覧(最新更新順) ]

[[20230307220120]] 『マクロで高速で行挿入して同じ値を複数行増産した』（くらら） ページの最後に飛ぶ

[[20230307220120]]　『マクロで高速で行挿入して同じ値を複数行増産した』（くらら）　ページの最後に飛ぶ