首页 > 解决方案 > 无法循环遍历单元格

问题描述

嗨,我之前发布了关于运行循环的一些困难。我对其进行了一些调整。我想知道有什么问题。

Sub Macro1()
    Dim DVariable As Date
    Dim RngFind As Range
    Dim MonthNo, YearNo As Integer
    Dim StartDate, EndDate As Date
    Dim PasteCell As Range
    Dim M As Long, i As Long
    Dim ws As Worksheet
    Dim ws1 As Worksheet

    Application.DisplayAlerts = False
    Sheets("By Trader").Select
    Set ws1 = ThisWorkbook.Sheets.Add(After:= _
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws1.Name = "NEW"
    Set ws = Sheets("Macro")
    Sheets("Macro").Select
    M = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For M = 2 To M
            With Sheets("By Trader")
    'loop column N until last cell with value (not entire column)
                For Each Cell In .Range("N1:N" & .Cells(.Rows.Count, "N").End(xlUp).Row)
                    If Cell.Value = M Then
             ' Copy>>Paste in 1-line (no need to use Select)
                    .Rows(Cell.Row).Copy Destination:=Sheets("NEW").Rows(Cell.Row)
                    End If
                Next M
    Application.DisplayAlerts = True
End Sub

如果值与另一张表匹配,我的目标是提取整行。

标签: excelvba

解决方案


你缺少一个Next Cell和一个End With

Sub Macro1()
    Dim DVariable As Date
    Dim RngFind As Range
    ' You need to declare every variable in the line. If you don't it will be declared as a variant instead of just your last declaration
    Dim MonthNo As Integer, YearNo As Integer
    Dim StartDate, EndDate As Date
    Dim PasteCell As Range
    Dim M As Long, i As Long, NoRow As Long
    Dim ws As Worksheet
    Dim ws1 As Worksheet

    Application.DisplayAlerts = False
    Sheets("By Trader").Select
    Set ws1 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws1.Name = "NEW"
    Set ws = Sheets("Macro")
    ws.Select
    ' Changed variable to prevent erroneous errors
    NoRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For M = 2 To NoRow
            With Sheets("By Trader")
    'loop column N until last cell with value (not entire column)
                For Each Cell In .Range("N1:N" & .Cells(.Rows.Count, "N").End(xlUp).Row)
                    If Cell.Value = M Then
                        ' Copy>>Paste in 1-line (no need to use Select)
                    .Rows(Cell.Row).Copy Destination:=Sheets("NEW").Rows(Cell.Row)
                    End If
                ' Missing the next two lines
                Next Cell
            End With
        Next M
    Application.DisplayAlerts = True
End Sub

推荐阅读