search多个值并执行一些操作
我有一列数据要通过search。 如果列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单元格中find一个值，并将相关单元格复制到E列，然后停止。
我需要它从D2单元中获取另一个值，然后再做一次。 （我需要循环我猜）。 然后D3，D4等，而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 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
如果您比较每列中相同行号中的值，则可以使此代码运行一个小的更改。 把athletename=Sheets.("db1").Range("D1").Value 。 “运动名”的价值将会随着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
在下一个单元格被选中时，你需要第二个循环来改变运动员的值。 我假设列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
经过一些testing，我意识到奇怪的事情正在发生：
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
第一行是OK！ D1 = A1，然后取B1，复制到E1等等。 但是当它达到56666 – 它只是打破。 我不明白它为什么把3999放到E cell！