VBA执行错误1004

时间:2018-03-30 11:13:11

标签: excel vba excel-vba

我试图将一个值与三个不同列中的三个值进行比较(第一个值必须与所有其他值进行比较)。 我使用了这段代码,我在if行得到了执行错误1004。

Option Explicit

Sub tests_selection()
    Dim SrcWs As Worksheet
    Set SrcWs = Worksheets("Feuil1")
    Dim SrcWs2 As Worksheet
    Set SrcWs2 = Worksheets("Feuil2")

    Dim ResultWs As Worksheet
    Set ResultWs = Worksheets("result")

    Dim rRow As Long
    rRow = 2

    Dim j As Long


      Dim iCell As Range
    For Each iCell In SrcWs.Range("A1:A4700")

            For j = 0 To 4700


         If iCell.Value = SrcWs.Cells(j, 2).Value And iCell.Value = SrcWs.Cells(j, 3) And iCell.Value = SrcWs.Cells(j, 4) Then

        ResultWs.Cells(rRow, 1).Value = SrcWs.Cells(iCell.Row, 1).Value
        ResultWs.Cells(rRow, 2).Value = SrcWs.Cells(iCell.Row, 2).Value
        ResultWs.Cells(rRow, 1).Value = SrcWs.Cells(iCell.Row, 4).Value
        ResultWs.Cells(rRow, 2).Value = SrcWs.Cells(iCell.Row, 5).Value

            rRow = rRow + 1
        End If
            Next j
        Next iCell

End Sub

2 个答案:

答案 0 :(得分:6)

Cells(j,2)会在j=0时发出错误。没有第0行

尝试:

 For j = 1 to 4700

答案 1 :(得分:-1)

你可能会追随以下内容

Option Explicit

Sub tests_selection()    
    Dim ResultWs As Worksheet
    Set ResultWs = Worksheets("result")

    Dim rRow As Long
    rRow = 2

    Dim cell As Range
    With Worksheets("Feuil1") 'reference Feuil1 worksheet
        For Each cell In .Range("A1", .Cells(.Rows.count, 1).End(xlUp)) ' loop through referenced sheet column A cells from row 1 down to last not empty one
            If WorksheetFunction.Rept(cell.Value, 4) = Join(Application.Transpose(Application.Transpose(cell.Resize(, 4).Value)), "") Then ' if current cell value is repeated in adjacent three cells
                ResultWs.Cells(rRow, 1).Resize(, 4).Value = Array(cell.Value, _
                                                                  cell.Offset(, 1).Value, _
                                                                  cell.Offset(, 3).Value, _
                                                                  cell.Offset(, 4).Value)
                rRow = rRow + 1
            End If
        Next
    End With
End Sub