Excel VBA 从数组的单元格中查找一个值并将 return 值添加到新列

Question

你好，我是 VBA 的新手。我没有包括我试过的代码，因为没有什么比这更接近了。

我有一个大约 10,000 的数据范围，其中包含建筑物、部门、用户名和可能的其他信息。此信息在 B 列中。名称不在每个单元格的相同位置，它们可以是任何大小写，最多可以包含 4 个单词。

我在名为数据库的单独工作簿中有大约 14,000 个名称的命名范围（全名）。

我需要查看名称是否显示在数据范围列表中，如果是，则用名称填充 C 列。

在此先感谢您的帮助。

示例代码：

Sub Full_Name()
    
    Dim iWs As Worksheet, iFn As Variant, lastrow As Long, iDB As Worksheet
    
    iFn = Range("'[Shadow Datafie Database.xlsx]EMCP'!Full_Name").Value
    Set iWs = ActiveWorkbook.Worksheets("EMCP")
    lastrow = iWs.UsedRange.Rows.Count + 1
    
    For i = 2 To lastrow
        If InStr(iWs.Cells(i, 2), iFn) > 0 Then
            iWs.Cells(i, 3) = iFn
        End If
    Next
    
End Sub

Answer 1

此代码可能适合您：

它假定您的姓名列表位于名为 Table1.

的 Excel table 中

Sub FindName()

    'Open the csv file containing your information - building, department, etc.
    Dim wrkBkSrc As Workbook
    Set wrkBkSrc = Workbooks.Open("<path to your file>\Numplan(11).csv")

    'A csv file will only contain a single sheet, so can reference it by sheet position - first and only.
    With wrkBkSrc.Worksheets(1)
        Dim DataRange As Range
        Set DataRange = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
    End With
    
'    *** OLD CODE ***
'    With ThisWorkbook.Worksheets("Sheet1")
'        Dim DataRange As Range
'        Set DataRange = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
'    End With
    
    'Open the database file and set reference to it.
    Dim wrkBk As Workbook
    Set wrkBk = Workbooks.Open("<path to your file>\Database.xlsx")
    
    'Set reference to the names table.
    'Note: This is an Excel table, not an Excel range.
    '      Press Ctrl+T to turn range into a table.
    Dim NameTable As ListObject
    Set NameTable = wrkBk.Worksheets("Database").ListObjects("Table1")
    
    'Only continue if there's data in the table.
    If Not NameTable.DataBodyRange Is Nothing Then
        Dim NameItm As Range
        Dim FoundItm As Range
        For Each NameItm In NameTable.DataBodyRange
            'Find the name within the DataRange.
            Set FoundItm = DataRange.Find( _
                What:=NameItm, _
                After:=DataRange.Cells(1, 1), _
                LookIn:=xlValues, _
                LookAt:=xlPart, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            
            'If it's found place the name in the next column along.
            If Not FoundItm Is Nothing Then
                FoundItm.Offset(, 1) = NameItm
            End If
        Next NameItm
    End If
    
End Sub

Excel VBA 从数组的单元格中查找一个值并将 return 值添加到新列

Excel VBA Find a value within a cell from an array and return value to new column

arrays

excel

vba