使用If Then語句不起作用的數據排序

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

好吧，我明白了。我最大的問題是我的約會。他們需要像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 

Answer 2

再次感謝您清理代碼並幫助調試它。

你的問題在於你使用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 s到And s，使用Copy Destination而不是Copy Paste）是可選的。