Question

所以我有一个查询，我试图使用For Loop和If Then语句来提取和排序数据。该声明的目的是采用我的标准并查看匹配事物的数据。如果它们匹配，则将该数据中的值复制到列中。我有三组标准可以查看相同的数据。每个条件都有3个字符串和一个日期范围。

由于某种原因，它将所有数据复制到所有三个粘贴位置。请参阅参考图像：

右边的单元格是我的第一组标准。第二组就在那之下。左边的彩色单元格是我的数据。

我唯一能想到的是我引用的单元格位置错误。我目前正在使用（行，列）坐标系。示例：.Cells("B2")与.Cells(2, 2)相同。

以下是有问题的代码

'
    Dim j As Long

    For j = 1 To ActiveWorkbook.Connections.Count
        ActiveWorkbook.Connections(j).OLEDBConnection.BackgroundQuery = False
    Next

    ActiveWorkbook.RefreshAll

    Worksheets("Query").Activate
    ActiveSheet.ListObjects("Table_WinSPCData.accdb").Range.AutoFilter Field:=14 _
    , Criteria1:="=81024 OK", Operator:=xlOr, Criteria2:="=81111 OK"

ActiveSheet.ListObjects("Table_WinSPCData.accdb").Range.AutoFilter Field:=1, _
    Criteria1:=Array("DD_IMPELLER_SEAL_RING_004", "DD_IMPELLER_SEAL_RING_005", _
    "DD_IMPELLER_SEAL_RING_007", "DD_IMPELLER_SEAL_RING_008", _
    "GD_1ST_STAGE_IMPELLER_SEAL_RING", "GD_2ND_STAGE_IMPELLER_SEAL_RING", _
    "IMPELLER_SEAL_RING", "INTERSTAGE_SEAL_RING", "MOTOR_SEAL_RING", _
    "MOTOR_SEAL_RING_WITH_PILOT", "MOTOR_SEAL_RING_WITH_PILOT_005"), Operator:= _
    xlFilterValues

    Range("A:A,E:E,H:H,I:I").Select
    Range("Table_WinSPCData.accdb[[#Headers],[VALUE_]]").Activate
    Range("A:A,E:E,H:H,I:I,N:N").Select
    Range("Table_WinSPCData.accdb[[#Headers],[TAG_VALUE]]").Activate
    Selection.Copy
    Sheets("1").Range("A1").PasteSpecial xlPasteValues

    Application.CutCopyMode = False


Dim i As Long
Dim AssetRight1 As Range
Dim AssetRight2 As Range
Dim AssetRight3 As Range
Dim AssetLeft1 As Range

Dim PartnameRight1 As Range
Dim PartnameRight2 As Range
Dim PartnameRight3 As Range
Dim PartnameLeft1 As Range

Dim VariablenameRight1 As Range
Dim VariablenameRight2 As Range
Dim VariablenameRight3 As Range
Dim VariablenameLeft1 As Range

Dim Criteria1paste As Range
Dim Criteria2paste As Range
Dim Criteria3paste As Range


    Set AssetRight1 = Cells(2, 20)
    Set AssetRight2 = Cells(3, 20)
    Set AssetRight3 = Cells(4, 20)
    Set AssetLeft1 = Cells(2 + i, 5)

    Set PartnameRight1 = Cells(2, 21)
    Set PartnameRight2 = Cells(3, 21)
    Set PartnameRight3 = Cells(4, 21)
    Set PartnameLeft1 = Cells(2 + i, 1)

    Set VariablenameRight1 = Cells(2, 22)
    Set VariablenameRight2 = Cells(3, 22)
    Set VariablenameRight3 = Cells(4, 22)
    Set VariablenameLeft1 = Cells(2 + i, 2)

    Set Criteria1paste = Cells(2 + i, 8)
    Set Criteria2paste = Cells(2 + i, 9)
    Set Criteria3paste = Cells(2 + i, 10)

    For i = 0 To 20

    If AssetRight1 = AssetLeft1 Then If VariablenameRight1 = VariablenameLeft1 Then If PartnameRight1 = PartnameLeft1 Then If Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 3) <= Worksheets("Date").Range("D4") Then Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy

            Criteria1paste.PasteSpecial xlPasteValues

                    Application.CutCopyMode = False

    If AssetRight2 = AssetLeft1 Then If VariablenameRight2 = VariablenameLeft1 Then If PartnameRight2 = PartnameLeft1 Then If Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 3) <= Worksheets("Date").Range("D4") Then Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy

            Criteria2paste.PasteSpecial xlPasteValues

                    Application.CutCopyMode = False

    If AssetRight3 = AssetLeft1 Then If VariablenameRight3 = VariablenameLeft1 Then If PartnameRight3 = PartnameLeft1 Then If Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 3) <= Worksheets("Date").Range("D4") Then Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy

            Criteria3paste.PasteSpecial xlPasteValues

                    Application.CutCopyMode = False

    Next i

End Sub

抱歉，这太乱了。我记录了大部分内容，所以它到处都是。提前致谢。

更新好的，现在是For Next Code As。出于某种原因，For Next循环存在问题。它说有一个Next without a For。

For i = 0 To 20

    If AssetRight1 = AssetLeft1 And _
    VariablenameRight1 = VariablenameLeft1 And _
    PartnameRight1 = PartnameLeft1 And _
        Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 7) <= Worksheets("Date").Range("D4") Then

            Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Criteria1paste


    If AssetRight2 = AssetLeft1 And _
    VariablenameRight2 = VariablenameLeft1 And _
    PartnameRight2 = PartnameLeft1 And _
        Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 7) <= Worksheets("Date").Range("D4") Then

            Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Criteria2paste

    If AssetRight3 = AssetLeft1 And _
    VariablenameRight3 = VariablenameLeft1 And _
    PartnameRight3 = PartnameLeft1 And _
        Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 7) <= Worksheets("Date").Range("D4") Then

            Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Criteria3paste

Next i

Answer 1

再次感谢您清理代码并帮助调试代码。

您的问题在于使用If/Then/Else代码行的方式。

您需要更改此样式：

If AssetRight1 = AssetLeft1 Then If VariablenameRight1 = VariablenameLeft1 Then If PartnameRight1 = PartnameLeft1 Then If Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 3) <= Worksheets("Date").Range("D4") Then Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy

    Criteria1paste.PasteSpecial xlPasteValues

            Application.CutCopyMode = False

这种风格：

If AssetRight1 = AssetLeft1 And _
VariablenameRight1 = VariablenameLeft1 And _ 
PartnameRight1 = PartnameLeft1 And _ 
Cells(2 + i, 7) >= Worksheets("Date").Range("D3") And Cells(2 + i, 3) <= Worksheets("Date").Range("D4") Then 
    Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Criteria1paste
End If

具体来说，当您有多个操作要做时（复制，粘贴等），您错误地将Then操作放在与If条件相同的行上。如果您将Then操作放在与If条件相同的行上，则VBA会假定If/Then/Else在该行上结束。因此，无论是否通过了If条件，VBA始终都会运行粘贴代码。

我做出的其他更改（使用If Then而非And将Copy Destination切换为Copy Paste是可选的。

Answer 2

好的，我明白了。我最大的问题是我的约会。他们需要像As Date下面的代码一样完成。第二大问题是我的所有Set功能。因为我正在比较单元格内的字符串，所以不能将它们用作`.Range'对象。这是代码。

Sub update_query_and_slide_1()



Dim j As Long

For j = 1 To ActiveWorkbook.Connections.Count

    ActiveWorkbook.Connections(j).OLEDBConnection.BackgroundQuery = False

Next

ActiveWorkbook.RefreshAll

Worksheets("Query").Activate
ActiveSheet.ListObjects("Table_WinSPCData.accdb").Range.AutoFilter Field:=14 _
    , Criteria1:="=81024 OK", Operator:=xlOr, Criteria2:="=81111 OK"

ActiveSheet.ListObjects("Table_WinSPCData.accdb").Range.AutoFilter Field:=1, _
    Criteria1:=Array("DD_IMPELLER_SEAL_RING_004", "DD_IMPELLER_SEAL_RING_005", _
    "DD_IMPELLER_SEAL_RING_007", "DD_IMPELLER_SEAL_RING_008", _
    "GD_1ST_STAGE_IMPELLER_SEAL_RING", "GD_2ND_STAGE_IMPELLER_SEAL_RING", _
    "IMPELLER_SEAL_RING", "INTERSTAGE_SEAL_RING", "MOTOR_SEAL_RING", _
    "MOTOR_SEAL_RING_WITH_PILOT", "MOTOR_SEAL_RING_WITH_PILOT_005"), Operator:= _
    xlFilterValues

Range("A:A,E:E,H:H,I:I").Select
Range("Table_WinSPCData.accdb[[#Headers],[VALUE_]]").Activate

Range("A:A,E:E,H:H,I:I,N:N").Select
Range("Table_WinSPCData.accdb[[#Headers],[TAG_VALUE]]").Activate
Selection.Copy
Sheets("1").Select
Range("A1").Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False

Dim i As Long
Dim Counter As Long

Dim Startdate As Date
Dim Enddate As Date
Dim Datadate As Date

Startdate = Worksheets("Date").Range("D2").Value
Enddate = Worksheets("Date").Range("D3").Value
Datadate = Worksheets("1").Cells(2 + i, 3).Value

Worksheets("1").Activate

For Counter = 0 To 11
For i = 0 To 2000

    If Cells(Counter + 2, 20).Value = Cells(2 + i, 5).Value And _
    Cells(Counter + 2, 22).Value = Cells(2 + i, 2).Value And _
    Cells(Counter + 2, 21).Value = Cells(2 + i, 1).Value And _
    Datadate >= Startdate And Datadate <= Enddate Then

        Rows(2 + i).Cells.Find("XXX").Offset(0, -2).Copy Cells(2 + i, Counter + 8)

    End If

 Next i
 Next Counter

 End Sub

使用If Then语句进行数据排序

2 个答案: