从另一列中搜索列的值

Question

我对VBA很新，我正试图解决一个我无法在这里找到答案的问题。

我有3列数据， 你可以在这里看到：

我想写一个宏，我可以用它来搜索A中D列的第一个果实。如果宏找到匹配，我想将水果（B）的属性（例如蔬菜）复制到旁边的E相应的名称。

一个例子： D6 =菠萝 在A中搜索菠萝，然后将B4（水果）复制到E2。 然后继续使用D3（鳄梨）执行相同的操作。

这是我到目前为止所提出的。我知道这很糟糕，根本不起作用：＆＃39;）

Option Explicit

Sub fruits()

Dim fruit As String
Dim i As Integer

i = 1

Do While i < 20


    Set fruit = Cells(i, "D").Value

    If Not fruit Is Nothing Then

    Set Cells(i, "E") = Columns(1).find(fruit.Value).Offset(0, 1).Text

    End If

  i = i + 1
Loop

End Sub

如果您有任何建议或解决方案，我将非常感激。

很抱歉，我发布了这样一个＆＃39;琐碎的＆＃39;问题，但我真的不知道怎么做。

谢谢，NiceRice

Answer 1

我同意Scott Craner，使用Vlookup是可行的方法，但我想我会分享一种稍微不同的方法来使用Find方法在VBA中完成相同的操作：

Option Explicit

Sub fruits()
Dim LastRow As Long, LastARow As Long
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastDRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
'get the last row with data on Column D
LastARow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim rng As Range, c As Range, FoundVal As Range

Set rng = ws.Range("D1:D" & LastDRow)

For Each c In rng
    Set FoundVal = ws.Range("A1:A" & LastARow).Find(What:=c.Value)
    If Not FoundVal Is Nothing Then
        c.Offset(0, 1).Value = FoundVal.Offset(0, 1).Value
    End If
Next
End Sub

Answer 2

dim rng as range, rng2 as range, rcell as range, rcell2 as range
set rng = Thisworkbook.sheets("sheetName").range("d1:d3")
set rng2 = Thisworkbook.sheets("sheetName").range("a1:a8")

for each rcell in rng.cells
    if rcell.value <> vbNullstring then
        for each rcell2 in rn2.cells
            If rcell.value = rcell2.value then
                rcell.offset(0,1).value = rcell2.value  
            end if      
        next rcell2
    end if
next rcell

非常直接