データの並べ替えIf Thenステートメントが機能しない

Question

したがって、For LoopとIf Thenステートメントを使用してデータを取得およびソートしようとするクエリがあります。この声明の目的は、私の基準をとり、一致するもののデータを調べることです。一致した場合は、そのデータの値を列にコピーします。同じデータを見ている3つの基準があります。各条件には3つの文字列と日付範囲があります。

何らかの理由で、すべてのデータを3つの貼り付け場所すべてにコピーします。参考のために画像を参照してください：右の

細胞着色が基準の私の最初のセットです。 2番目のセットはそのすぐ下にあります。左の色付きのセルが私のデータです。

私が考えることができるのは、私がセルの場所を間違って参照していることだけです。私は現在、（行、列）座標系を使用しています。例：.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コードがあります。なんらかの理由でループに問題があります（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と下のコードのようにする必要がありました。 2番目に大きい問題はすべて私の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条件時と同じライン上Thenアクションを置くことの間違いを作っていた、具体的に

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 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 

：

あなたはこのスタイルを変更する必要があります（コピー、貼り付けなど）、複数のアクションが必要でした。 ThenアクションをIf条件と同じ行に配置すると、VBAはその行でIf/Then/Elseが終了するとみなします。したがって、VBAは、Ifの条件が満たされているかどうかにかかわらず、常にペーストコードを実行していました。

Copy PasteではなくCopy Destinationを使用して、If ThenをAndに変更しました。これはオプションです。