数据sorting与If Then语句不起作用
所以我有一个查询，我试图拉和使用For Loop和一个If Then语句sorting数据。 声明的目的是采取我的标准，并通过数据查看匹配的东西。 如果它们匹配，则它将该数据中的值复制到列中。 我有三组标准来查看相同的数据。 每个标准有3个string和一个date范围。
出于某种原因，它将所有数据复制到全部三个粘贴位置。 查看图片参考：
右边的单元格是我的第一套标准。 第二组直接在下面。 左边的彩色单元格就是我的数据。
我能想到的唯一的事情就是我正在引用单元格位置错误。 我目前正在使用（行，列）坐标系。 例如： .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
对不起，这是一个烂摊子。 我logging了大部分，所以它是在所有的地方。 提前致谢。
更新好的，这里是For Next代码现在。 由于某种原因， 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
再次感谢您清理代码并帮助进行debugging。
您的问题在于您使用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
具体来说，当您有多个要执行的操作（复制，粘贴等）时，您将错误的操作放在与If条件相同的行上。 如果您将一个Then操作放在与If条件相同的行上，VBA将假定If/Then/Else在该行结束。 因此，无论If条件是否通过，VBA总是运行你的粘贴代码。
我做的其他更改（切换If Then s And使用Copy Destination而不是Copy Paste ）是可选的。
好吧，我知道了。 我最大的问题是我的约会。 他们需要像下面的代码一样用As Date来完成。 第二大问题是我所有的function。 因为我比较单元格内的string，所以不能将它们用作`.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