Excelで周期的に空白行を入れていきたい


Excelの質問です。
今ズラリと、1万行以上のデータがA列に並んでいるのですが。
うまい具合に分割したいと思いまして。
5行目からデータが並んでまして、

最初は40行目と41行目に空白の行。
(42行目から76行目はデータが並び…)
次に77行目と78行目に空白の行。
(79行目から113行目はデータが並び…)
次は114行目と115行目が空白の行。



といった感じで。
35行毎に、空白行を2行ずつ挿入していきたいです。
(データは上書きしたくないです)

マクロや関数等で効率的にできれば…と考えております。
よろしくお願い致します。

回答の条件
  • 1人20回まで
  • 登録:
  • 終了:2018/09/17 01:11:45
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:Z1000S No.2

回答回数39ベストアンサー獲得回数27

ポイント350pt

こんな感じで・・・

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
id:moon-fondu

ありがとうございます、うまくいきました!

2018/09/17 01:10:43

その他の回答2件)

id:Asayuri No.1

回答回数309ベストアンサー獲得回数65

ポイント300pt

 
  計算のために 数値で 小数点以下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列を削除します
 
  これで ご希望のデータを作成することができます
 
 
 
 
 

id:moon-fondu

Asayuriさんご回答ありがとうございます、試してみました!
「2.セルC1に =roundup(B1-39)/35,0) を入力します」のところで「この関数に対して、少なすぎる引数が入力されています。」というエラーが出てきまして進まない状況になりまして…。

2018/09/16 00:27:55
id:moon-fondu

最後までいきました!
すごいっすね、関数を駆使すると、A列に周期的に空白セルが入るんですね。
ありがとうございます。

2018/09/17 01:07:52
id:Z1000S No.2

回答回数39ベストアンサー獲得回数27ここでベストアンサー

ポイント350pt

こんな感じで・・・

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
id:moon-fondu

ありがとうございます、うまくいきました!

2018/09/17 01:10:43
id:huumm No.3

回答回数8ベストアンサー獲得回数2

ポイント350pt

もう十分間に合っているかと思いますが、勉強ついでに組んだのでどうぞ。

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


id:moon-fondu

うまくいきました!ありがとうございます。

2018/09/17 01:10:54
id:moon-fondu

皆さんありがとうございました。

ベストアンサー、迷いましたが。

一番速く結果が出る方法にさせていただきました(^^;

Z1000Sさんとフームー母さんの方法は、ほぼ同じスピードで結果出ましたが、

回答順ということでよろしくお願い致します<m(__)m>

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません