使用If Then语句不起作用的数据排序

因此，我正在尝试使用For Loop和If Then语句对数据进行抽取和排序。该声明的目的是采取我的标准，并查看相匹配的事物的数据。如果它们匹配，则它将该数据中的值复制到列中。我有三组标准来查看相同的数据。每个标准都有3个字符串和一个日期范围。使用If Then语句不起作用的数据排序

出于某种原因，它将所有数据复制到所有三个粘贴位置。看到图像以供参考：

右边的细胞色是我的第一套标准。第二组直接在下面。左边的彩色单元格就是我的数据。

我能想到的唯一的事情就是我引用单元格位置错误。我目前正在使用（行，列）坐标系。例如：.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

来源

2016-08-18 Keizzerweiss

我会被清理选择开始：http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros – puzzlepiece87

@ puzzlepiece87我可以删除'ActiveWindow.ScollColumn'行。他们是否使用过，或者他们只是从我录制的内容中删除？有没有我可以删除的行，因为他们做的东西与代码无关。 – Keizzerweiss

是的，你可以删除'ActiveWindow.ScrollColumn'行。在所有的'.Select'和'Selection'都被修正之前，对其余的部分都没有评论，因为在大问题解决之前，这并不值得挑剔。 – puzzlepiece87

好吧，我明白了。我最大的问题是我的约会。他们需要像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

来源

2016-08-22 16:15:36 Keizzerweiss

为了所有将来维护代码的人，为了您自己的利益，请遵循拼图的建议并避免使用'select'（http://stackoverflow.com/questions/10714251/how-to-避免-使用选功能于Excel的VBA的宏） –

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

你的问题在于你使用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）是可选的。

来源

2016-08-18 17:09:00 puzzlepiece87

有趣。 VBA不喜欢格式。它表示它在错误消息上预期表达式。我尝试了一下，但它似乎并没有工作。 – Keizzerweiss

@Keizzerweiss对不起，我不小心留下了额外的'如果'在那里，我只拿出'然后'。我纠正了第二块代码。 – puzzlepiece87

现在它对我的'For'' Next'命令有问题。它表示没有'For'代表'Next'。查看我的主要帖子以获取代码更新。没有足够的空间放在这里。 – Keizzerweiss

使用If Then语句不起作用的数据排序

回答

相关问题