0

私はVBAのバックグラウンドをあまり持っていませんが、ボタンを押すと、特定の範囲でチェックマークが付いていないすべての行が削除されるマクロを作成しようとしています。私はいくつかのフォーラムを閲覧し、そのフォントの文字「a」がチェックマークとして表示される「marlett」チェックについて知りました。適切な範囲の A 列のセルをクリックすると、「marlett チェック」を自動的に生成する必要があるコードを次に示します。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A10:A111")) Is Nothing Then
            Target.Font.Name = "Marlett"
                If Target = vbNullString Then
                    Target = "a"
                Else
                    Target = vbNullString
                End If
        End If

End Sub

次に、ボタンが押されたときに「A」列にチェックマークが付いていない行を実際に削除する別のマクロ (ボタンに割り当てられた) があります。

Sub delete_rows()

Dim c As Range

On Error Resume Next
For Each c in Range("A10:A111")
    If c.Value <> "a" Then
        c.EntireRow.Delete
    End If
Next c

End Sub

すべてが機能しますが、唯一の問題は、チェックされていないすべての行が削除される前に、ボタンを複数回押す必要があることです!! 私のループが正しく動作していないようです - 誰でも助けてもらえますか??

ありがとう！

4

1 に答える 1

2

これは、行を削除する方法が原因である可能性があると思います。削除するたびに行をスキップしている可能性があります。

通常の for ループの for-each を変更したい場合があります。作業中のインデックスを制御できます。この回答または質問に対する他の回答を参照して、その方法を確認してください。

あなたの（可能性のある）問題に合うはずの修正版があります。

Sub Main()
    Dim Row As Long
    Dim Sheet As Worksheet
    Row = 10
    Set Sheet = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Do
        If Sheet.Cells(Row, 1).Value = "a" Then
            'Sheet.Rows(Row).Delete xlShiftUp
            Row = Row + 1
        Else
            'Row = Row + 1
            Sheet.Rows(Row).Delete xlShiftUp
        End If
    Loop While Row <= 111
    Application.ScreenUpdating = True
End Sub

更新 if ブロックに行った編集を試してみてください。エクセルができたら見てみます。

提案された変更に関係なく、無限ループに入ります。問題は、データの終わりに近づいたときに、空の行が継続的に検出されたため (これ以上データがないため!)、それらを削除し続けたことです。

ただし、以下のコードは機能するはずです。

Sub Main()
    Dim Row As Long: Row = 10
    Dim Count As Long: Count = 0
    Dim Sheet As Worksheet
    Set Sheet = Worksheets("Sheet1")
    Application.ScreenUpdating = False
    Do
        If Sheet.Cells(Row, 1).Value = "a" Then
            Row = Row + 1
        Else
            Count = Count + 1
            Sheet.Rows(Row).Delete xlShiftUp
        End If
    Loop While Row <= 111 And Row + Count <= 111
    Application.ScreenUpdating = True
End Sub
于 2013-04-05T17:19:14.687 に答える