Excelの質問です。
今ズラリと、1万行以上のデータがA列に並んでいるのですが。
うまい具合に分割したいと思いまして。
5行目からデータが並んでまして、
最初は40行目と41行目に空白の行。
(42行目から76行目はデータが並び…)
次に77行目と78行目に空白の行。
(79行目から113行目はデータが並び…)
次は114行目と115行目が空白の行。
・
・
・
といった感じで。
35行毎に、空白行を2行ずつ挿入していきたいです。
(データは上書きしたくないです)
マクロや関数等で効率的にできれば…と考えております。
よろしくお願い致します。
こんな感じで・・・
Public Sub insertRows() Const TARGET_SHEET_NAME As String = "Sheet1" Const BEGIN_ROW As Long = 5 Const BLOCK_ROWS As Long = 35 Const INSERT_ROWS As Long = 2 Dim lBlocks As Long Dim lEndRow As Long Dim lRow As Long Dim i As Long With ThisWorkbook.Worksheets(TARGET_SHEET_NAME) lEndRow = .Cells(.Rows.Count, 1).End(xlUp).Row lBlocks = (lEndRow - BEGIN_ROW + 1) \ BLOCK_ROWS If lEndRow = BEGIN_ROW - 1 + lBlocks * BLOCK_ROWS Then lBlocks = lBlocks - 1 End If For i = lBlocks To 1 Step -1 lRow = BEGIN_ROW - 1 + BLOCK_ROWS * i .Range("A" & CStr(lRow + 1)).Resize(INSERT_ROWS).EntireRow.Insert Next i End With Debug.Print "Done." End Sub
計算のために 数値で 小数点以下1位まで使います
1.セルB1に =ROW(A1) を入力します
2.セルC1に =roundup((B1-39)/35,0) を入力します
3.セルD1に =B1+C1*2 を入力します
4.セルB1、C1、D1を 範囲指定し コピーして
セルB2、C2、D2から データ最終行までに 貼り付けします
5.セルE1に =39.1 セルE2に =39.2 セルE3に =E1+37 を入力してから
セルE3を コピーして E4からE600までに 貼り付けします
6.B列、C列、D列、E列を範囲指定し コピーして そのまま 値 貼り付けします
7.セルE1からE600を範囲指定し コピーして
D列のデータがある最終行セルの下のセルに 貼り付けします
8.D列について 昇順で 並べ替えを行ってから B列C列D列E列を削除します
これで ご希望のデータを作成することができます
Asayuriさんご回答ありがとうございます、試してみました!
「2.セルC1に =roundup(B1-39)/35,0) を入力します」のところで「この関数に対して、少なすぎる引数が入力されています。」というエラーが出てきまして進まない状況になりまして…。
最後までいきました!
すごいっすね、関数を駆使すると、A列に周期的に空白セルが入るんですね。
ありがとうございます。
こんな感じで・・・
Public Sub insertRows() Const TARGET_SHEET_NAME As String = "Sheet1" Const BEGIN_ROW As Long = 5 Const BLOCK_ROWS As Long = 35 Const INSERT_ROWS As Long = 2 Dim lBlocks As Long Dim lEndRow As Long Dim lRow As Long Dim i As Long With ThisWorkbook.Worksheets(TARGET_SHEET_NAME) lEndRow = .Cells(.Rows.Count, 1).End(xlUp).Row lBlocks = (lEndRow - BEGIN_ROW + 1) \ BLOCK_ROWS If lEndRow = BEGIN_ROW - 1 + lBlocks * BLOCK_ROWS Then lBlocks = lBlocks - 1 End If For i = lBlocks To 1 Step -1 lRow = BEGIN_ROW - 1 + BLOCK_ROWS * i .Range("A" & CStr(lRow + 1)).Resize(INSERT_ROWS).EntireRow.Insert Next i End With Debug.Print "Done." End Sub
ありがとうございます、うまくいきました!
もう十分間に合っているかと思いますが、勉強ついでに組んだのでどうぞ。
Sub 行追加() Dim i As Long, v As Long, k As Long If Cells(Rows.Count, 1).End(xlUp).Row > 5 + 35 Then 'データの最終行数が40(開始行数5+間隔行数35)より多かった場合のみ処理を実行 v = (Cells(Rows.Count, 1).End(xlUp).Row - 5) \ 35 'データの最終行数-データの開始行数5を、35で割ってFor文の処理回数vを求める For i = 1 To v k = (i - 1) * 2 '空白行数ごとに増える変数 Range(Cells(35 * i, 1), Cells(35 * i + 1, 1)).Offset(5 + k, 0).EntireRow.Insert '2行追加 Next i Else MsgBox "データが指定行数以下です" 'データの最終行数が40以下だとMsgBox表示 End If End Sub
うまくいきました!ありがとうございます。
皆さんありがとうございました。
ベストアンサー、迷いましたが。
一番速く結果が出る方法にさせていただきました(^^;
Z1000Sさんとフームー母さんの方法は、ほぼ同じスピードで結果出ましたが、
回答順ということでよろしくお願い致します<m(__)m>
ありがとうございます、うまくいきました!
2018/09/17 01:10:43