如何找到范围内的每个名称并在下面粘贴一个值？

Question

我是编码新手，正在尝试使用 vba 搜索一系列名称并查找不同范围中的每个名称。找到该名称后，我需要将范围值粘贴到下面的下一个空单元格中。我让它搜索名称索引范围，但它在第二个范围中找不到匹配的名称，即使它在那里。 foundCell 范围始终显示为“Nothing”

这是我迄今为止生成的代码（在谷歌的帮助下）

Sub pasteDate()
With ActiveSheet
Dim dt As Range
Dim indexName As Range
Dim findRng As Range
Dim foundCell As Range
Set dt = Range("L15")
Set indexName = Range("Z1:AG12")
Set findRng = Range("B3:Y130")<sub>your text</sub>


For Each element In indexName

         Set foundCell = findRng.Find(element.Value)
         
         
      If Not foundCell Is Nothing Then
      
 Range(foundCell & Rows.Count).End(xlUp).Offset(1).Value = dt
 
        End If
    Next element


End With


End Sub

Answer 1

好的，请参阅下面我的评论。

With ActiveSheet
Dim dt As Range
Dim indexName As Range
Dim findRng As Range
Dim foundCell As Range
' Set dt = Range("L15") 'Range("L15")
Set dt = .Range("L15") 'Range("L15")
'Set indexName = Range("Z1:AG1") 'Range("Z1:AG12")
Set indexName = .Range("Z1:AG1") 'Range("Z1:AG12")
'Set findRng = Range("B3:Y130") 'Range("B3:Y130")
Set findRng = .Range("B3:Y130") 'Range("B3:Y130")
 For Each element In indexName
        Set foundCell = findRng.Find(element.Value)
             
        Dim columnLetter As String
        If Not foundCell Is Nothing Then
            'Range(foundCell & Rows.Count).End(xlUp).Offset(1).Value = dt
            columnLetter = Split(foundCell.Address, "$")(1)
            Range(columnLetter & .Rows.Count).End(xlUp).Offset(1).Value = dt
        End If
Next element

结束