Question

将我发现的一些代码拼凑在一起，我有两个选项，它们都给我错误。我知道答案很明显，但我似乎无法找到它......

错误总是出现在调试器的“IF”代码行上，通常是“_Global”不匹配等。

根据3个条件在不同的工作簿中搜索匹配项。如果所有三个都匹配，则将整行复制到当前工作簿中的下一个可用行。

可能有零匹配或者在给定的运行中可能有很多（这就是为什么“本周没有胜利”）。当我运行它时，它会很好，它会覆盖上次保存的结果。（我可以稍后处理）。

“wk1”是一个单元格中的论坛，根据= today（） - 14

给出周数

目标工作表上列的标题位于第3行。要检查其他工作簿的数据从第2行开始。要检查的数据是A列：AN，第2行到结尾（'000s）。

建议1，lngLoop：

Sub WinsUpdate()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb1 As Workbook, wb2 As Workbook
Dim lngLoop As Long
    lngLoop = 1
Application.ScreenUpdating = False
Set wb1 = Workbooks("Weekly Sales Dashboard")
Set wb2 = Workbooks("Monday Sales Meeting Data")
Set ws1 = wb1.Sheets("Roll_12")
Set ws2 = wb2.Sheets("Sales Weekly Wins")
Set wk1 = ws2.Range("C2")
With Workbooks("Weekly Sales Dashboard").Worksheets("Roll_12")
    For lngLoop = 1 To Rows.Count
    If Cells(lngLoop, 5).Value = "USA - Chicago" And Cells(lngLoop, 9).Value = "Closed/Won" And Cells(lngLoop, 18).Value = wk1 Then
        .EntireRow.Copy Destination:=ws2.Range("A:A" & Rows.Count).End(xlUp).Offset(1)
        Else: ws2.Range("F1") = "No wins this week"
    End If
    Next lngLoop
End With
Application.ScreenUpdating = True
End Sub

建议2：

Sub WinsUpdate()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb1 As Workbook, wb2 As Workbook
Application.ScreenUpdating = False
Set wb1 = Workbooks("Weekly Sales Dashboard")
Set wb2 = Workbooks("Monday Sales Meeting Data")
Set ws1 = wb1.Sheets("Roll_12")
Set ws2 = wb2.Sheets("Sales Weekly Wins")
Set wk1 = ws2.Range("C2")
With Workbooks("Weekly Sales Dashboard").Worksheets("Roll_12")
    If Range("E:E").Value = "USA - Chicago" And Range("L:L").Value = "Closed/Won" And Range("R:R").Value = wk1 Then
        .EntireRow.Copy Destination:=ws2.Range("A:A" & Rows.Count).End(xlUp).Offset(1)
        Else: ws2.Range("F1") = "No wins this week"
    End If
End With
Application.ScreenUpdating = True
End Sub

Answer 1

请尝试以下方法替代“建议1”：

Sub WinsUpdate()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim wb1 As Workbook, wb2 As Workbook
    Dim lngLoop As Long
    lngLoop = 1
    Application.ScreenUpdating = False
    Set wb1 = Workbooks("Weekly Sales Dashboard")
    Set wb2 = Workbooks("Monday Sales Meeting Data")
    Set ws1 = wb1.Sheets("Roll_12")
    Set ws2 = wb2.Sheets("Sales Weekly Wins")
    Set wk1 = ws2.Range("C2")
    With Workbooks("Weekly Sales Dashboard").Worksheets("Roll_12")
        For lngLoop = 2 To .Cells(.Rows.Count, 5).End(xlUp).Row ' Changed to avoid looking at a million rows
            If .Cells(lngLoop, 5).Value = "USA - Chicago" And _
               .Cells(lngLoop, 9).Value = "Closed/Won" And _
               .Cells(lngLoop, 18).Value = wk1 Then
                .Rows(lngLoop).EntireRow.Copy Destination:=ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1)
            Else
                ws2.Range("F1") = "No wins this week"
            End If
        Next lngLoop
    End With
    Application.ScreenUpdating = True
End Sub

我猜测您Cells块中的With等等是为了引用With块中指定的工作表。如果情况并非如此，您应该使用他们所引用的工作表正确地限定它们。

编辑以停止显示“本周没有获胜”，除非没有行符合条件：

Sub WinsUpdate()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim wb1 As Workbook, wb2 As Workbook
    Dim lngLoop As Long
    Dim WinFound as Boolean
    lngLoop = 1
    Application.ScreenUpdating = False
    Set wb1 = Workbooks("Weekly Sales Dashboard")
    Set wb2 = Workbooks("Monday Sales Meeting Data")
    Set ws1 = wb1.Sheets("Roll_12")
    Set ws2 = wb2.Sheets("Sales Weekly Wins")
    Set wk1 = ws2.Range("C2")
    With ws1
        WinFound = False
        For lngLoop = 2 To .Cells(.Rows.Count, 5).End(xlUp).Row ' Changed to avoid looking at a million rows
            If .Cells(lngLoop, 5).Value = "USA - Chicago" And _
               .Cells(lngLoop, 9).Value = "Closed/Won" And _
               .Cells(lngLoop, 18).Value = wk1 Then
                .Rows(lngLoop).EntireRow.Copy Destination:=ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1)
                WinFound = True
            End If
        Next lngLoop
        If Not WinFound Then
            ws2.Range("F1") = "No wins this week"
        End If
    End With
    Application.ScreenUpdating = True
End Sub

根据多个条件在工作簿中复制整行

1 个答案: