我试图将一个值与三个不同列中的三个值进行比较(第一个值必须与所有其他值进行比较)。 我使用了这段代码,我在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
答案 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