0

こんにちは、次の 2 つのマクロを作成しましたが、データを含む最後のセルの後に行を挿入しています。これは、ループ条件がDo Until ActiveCell.Value = "". データのある最後のセルでループを停止したいと思います。

変数を使用してみDo Until Loop_Long = LastRowましたが、これはうまくいきませんでした。

私が望むのは、データが異なるセルの間にマクロを挿入することだけです。次に、前に挿入した列の空のセルを見つけて、行を削除するマクロ。

上で概説したように、問題は余分な行を挿入し、それを削除しないことです。列 A のデータの後に列 B のずっと下に値を入れると、私の意味がわかります。

これが私のコードです：

Option Explicit

Sub Macro1()
'Insert Blank Row Between Names
Sheets("Sheet1").Select

Range("A1").Select
Do Until ActiveCell.Value = ""
    If ActiveCell.Value <> ActiveCell.Offset(1).Value Then
        ActiveCell.Offset(1).EntireRow.Insert
        ActiveCell.Offset(1).Select
    End If
    ActiveCell.Offset(1).Select
 Loop
End Sub

Sub Macro2()

Dim LastRow As Long

'Delete Inserted Rows
Sheets("Sheet1").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & LastRow).Select
Do Until ActiveCell.Value = Range("A1")
    If ActiveCell.Value <> ActiveCell.Offset(-1).Value Then
        ActiveCell.Offset(-1).EntireRow.Delete Shift:=xlUp
        ActiveCell.Offset(-1).Select
    End If
    ActiveCell.Offset(-1).Select
Loop
End Sub
4

1 に答える 1

0

あなたが私に言ったことから、以下のコードはあなたのために働くはずです（そしてそれはより良いベストプラクティスに従います）...データをそのままコピーし、データを新しい場所に貼り付けたら行を挿入することを検討しましたか？ ? それは一歩を切り取るでしょう。

Option Explicit
'Declare module-level variables.
Dim sht As Worksheet
Dim Cell As Range
Dim NameRng As Range
Dim LastRow As Long

Sub test()
'Add blank rows.
Set sht = ActiveWorkbook.Sheets("Sheet1")
LastRow = sht.Range("A" & Rows.count).End(xlUp).Row

Set NameRng = sht.Range("A1:A" & LastRow)

For Each Cell In NameRng
    If Cell <> Cell.Offset(1, 0) And Cell <> "" Then
        Cell.Offset(1, 0).EntireRow.Insert
    End If
Next Cell

End Sub
Sub test2()
'Delete blank rows.
Set sht = ActiveWorkbook.Sheets("Sheet1")
LastRow = sht.Range("A" & Rows.count).End(xlUp).Row

Set NameRng = sht.Range("A1:A" & LastRow + 1)

For Each Cell In NameRng
    If Cell = "" Then
        Cell.EntireRow.Delete
    End If
Next Cell

End Sub
于 2013-10-21T20:14:10.087 に答える