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

如果比较每列中相同行号的值，则可以使用较小的更改运行此代码。将athletename=Sheets.("db1").Range("D1").Value放在for循环中，如下所示。＆＃34; athletename＆＃34;的价值将在下一行选择并更改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 2

在检查下一个单元格时，您需要第二个循环来更改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 3

经过一些测试后，我意识到发生了奇怪的事情：

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

Answer 4

试试这个：

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

在多个值内搜索并执行某些操作

4 个答案: