在多个值中搜索并执行一些操作

Question

我有一列需要搜索的数据。如果D列中的值确实匹配，让我们说列A的值，那么我的脚本应该从列B中获取相关值并将其复制到正确的E单元格中。如果D1让我们说匹配A10，然后拿B10并复制到E10，继续D2。代码是：

Sub finddataalfa1() 

Dim athletename As String 
Dim finalrow As Integer 
Dim i As Integer 

athletename = Sheets("db1").Range("D1").Value 'we search for a value in D1 cell 

finalrow = Sheets("db1").Cells(Rows.Count, 1).End(xlUp).Row 'Finalrow 
For i = 1 To finalrow 
    If Cells(i, 1) = athletename Then 'if match between lets say D1 and A1 
    Cells(i, 5) = Cells(i, 2).Value 'copy B1 value to E1 cell 
End If 
Next i 
End Sub 

该脚本可以很好地处理第一个值。这是它的工作，并从A列中的D1单元格中找到一个值，并将相关单元格复制到E列，然后停止。

我需要它从D2单元获取另一个值并再次做同样的操作。 （我想我想循环）。然后D3，D4等，而D单元是空的。

Answer 1

试试这个：

Sub finddataalfa1() 

Dim athletename As String 
Dim finalrow_A As Integer 
Dim finalrow_D As Integer 
Dim i As Integer 
Dim j As Integer 

finalrow_A = Sheets("db1").Cells(Rows.count, 1).End(xlUp).Row 
finalrow_D = Sheets("db1").Cells(Rows.count, 4).End(xlUp).Row 

For i = 1 To finalrow_D 
    athletename = Sheets("db1").Cells(i, 4).Value 
    if athletename <> "Exclude This" then 
     If Not Application.IsError(Application.VLookup(athletename, Range("A1:B" & finalrow_A), 2, False)) Then 
      Range("D" & i).Offset(0, 1) = Application.VLookup(athletename, _ 
      Range("A1:B" & finalrow_A), 2, False) 
     End If 
    End if 

Next i 
End Sub 

Answer 2

如果比较每列中相同行号的值，那么可以使该代码运行一个小的更改。将athletename=Sheets.("db1").Range("D1").Value放在for循环中，如下所示。 “运动名”的价值将在下一行中更改i value。

For i = 1 To finalrow 
    athletename=Sheets.("db1").Range("D" & i).Value 
    If Cells(i, 1) = athletename Then 'if match between lets say D1 and A1 
    Cells(i, 5) = Cells(i, 2).Value 'copy B1 value to E1 cell 
    End If 
Next i 

Answer 3

当下一个单元格被选中时，您需要第二个循环来更改athletename的值。我假设列A和D的最大行不同，但如果它们相同，它仍然可以工作。

Sub finddataalfa1() 

Dim athletename As String 
Dim finalrow_A As Integer 
Dim finalrow_D As Integer 
Dim i As Integer 
Dim j As Integer 

finalrow_A = Sheets("db1").Cells(Rows.Count, 1).End(xlUp).Row 
finalrow_D = Sheets("db1").Cells(Rows.Count, 4).End(xlUp).Row 

For i = 1 To finalrow_D 
    athletename = Sheets("db1").Cells(i, 4).Value 

    For j = 1 To finalrow_A 
     If Cells(j, 1) = athletename Then 'if match between lets say D1 and A1 
      Cells(j, 5) = Cells(j, 2).Value 'copy B1 value to E1 cell 
     End If 
    Next j 
Next i 

End Sub 

Answer 4

一些测试后，我意识到奇怪的事情正在发生：

AB0023999 3999  AB0023999 3999 
AB0024000 4000  AB0024000 4000 
AB0024001 4001  AB0024001 4001 
AB0024002 4002  5000000 
AB0024003 4003  AB0024003 4003 
AB0024004 4000  AB0024004 4000 
AB0024005 4005  AB0024005 4005 
AB0024006 3999  AB0024006 3999 
AB0023999 3999  56666  3999 
AB0024000 4000  56666  4000 
AB0024001 4001  56667  4001 
AB0024002 4002  56668 
AB0024003 4003  56669  4003 
AB0024004 4000  56670  4000 
AB0024005 4005  56671  4005 
AB0024006 3999  56672  3999 
AB0023999 3999  56673  3999 
AB0024000 4000  56674  4000 

第一行是行！ D1 = A1然后它需要B1并复制到E1等。但是当它达到56666时 - 它只会打破。我不明白为什么它把3999放到E cell！？