excel - 如何用另一个工作表中的查找信息替换数据工作表中的索引号？

Question

我的数据工作表（“Sh1”）在 C 列中显示带有索引号的信息。
例如 1、2、3、4。

我有另一个工作表（“Sh2”）来确定每个数字的含义。
例如
单元 A1：1
单元 B1：制造

如何将 Sh1 的 C 列中的数字替换为 Sh2 的 B 列中的信息？

这就是我所拥有的

'Add information in data form
   Application.ScreenUpdating = False
   
   Dim NextRow As Long, Lastrow As Long
   
   Lastrow = Sheets("CustomerMaster").Range("C" & Rows.Count).End(xlUp).Row
   
   NextRow = Lastrow + 1
   
   'If formValidation = True Then

        Sheets("CustomerMaster").Cells(NextRow, 1) = Sheets("Customer Master Data Entry").TextID
        Sheets("CustomerMaster").Cells(NextRow, 2) = Sheets("Customer Master Data Entry").TextCompany
        Sheets("CustomerMaster").Cells(NextRow, 3) = Sheets("Customer Master Data Entry").DropDowns("Drop Down 8").Value
        Sheets("CustomerMaster").Cells(NextRow, 4) = Sheets("Customer Master Data Entry").TextRevenue
        Sheets("CustomerMaster").Cells(NextRow, 5) = Sheets("Customer Master Data Entry").TextAddress
        Sheets("CustomerMaster").Cells(NextRow, 6) = DropDowns("Drop Down 11").Value
        Sheets("CustomerMaster").Cells(NextRow, 7) = Sheets("Customer Master Data Entry").TextInitialCust
        Sheets("CustomerMaster").Cells(NextRow, 8) = Sheets("Customer Master Data Entry").TextSource
        Sheets("CustomerMaster").Cells(NextRow, 9) = Sheets("Customer Master Data Entry").TextEntered
        Sheets("CustomerMaster").Cells(NextRow, 10) = DropDowns("Drop Down 21").Value
        Sheets("CustomerMaster").Cells(NextRow, 11) = Sheets("Customer Master Data Entry").TextRemarkCust

标签： excelvbareplace

Answer 1

用值替换索引

• 调整常量部分中的值。
• 假定在 Source Lookup Column Range（Source First Column Range）中只考虑数字（索引）。它们不必排序。

编码

Option Explicit

Sub replaceIndexes()
    
    ' Constants
    
    ' Source
    Const srcName As String = "Sheet2"
    Const srcCols As String = "A:B"
    Const srcFirstRow As Long = 1
    ' Destination
    Const dstName As String = "Sheet1"
    Const dstFirstCell As String = "C1"
    ' Other
    Const Delimiter As String = ", "
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.

    ' Declare a range variable.
    Dim rng As Range
    
    ' Source
    
    ' Define Source Worksheet.
    With wb.Worksheets(srcName)
        ' Attempt to define Source Range.
        Set rng = defineNonEmptyRange(.Columns(srcCols).Rows(srcFirstRow))
    End With
    ' Validate Source Range.
    If rng Is Nothing Then
        Exit Sub
    End If
    ' Define Source Array.
    Dim Source As Variant: ReDim Source(1 To rng.Columns.Count)
    ' Declare a counter variable.
    Dim n As Long
    ' Loop through columns of Source Range (or, of arrays of Source Array).
    For n = 1 To rng.Columns.Count
        ' Write values from current column of Source Range to current
        ' element (array) of Source Array.
        Source(n) = getColumnRange(rng, n)
    Next n
    ' Reset range variable.
    Set rng = Nothing
    
    ' Destination
    
    ' Define Destination Worksheet.
    With wb.Worksheets(dstName)
        ' Attempt to define Destination Range.
        Set rng = defineNonEmptyRange(.Range(dstFirstCell))
    End With
    ' Validate Destination Range.
    If rng Is Nothing Then
        Exit Sub
    End If
    ' Write values from Destination Range to Destination Array.
    Dim Dest As Variant: Dest = getColumnRange(rng)
    
    ' Result
    
    ' Declare additional variables.
    Dim cValue As Variant ' Current Destination Value
    Dim cArray As Variant ' Current Array of Values
    Dim cVal As Variant ' Current Value in Array of Values
    Dim cMatch As Variant ' Current Match
    Dim i As Long ' Destination Rows Counter
    
    ' Loop through rows of Destination Array.
    For i = 1 To UBound(Dest, 1)
        ' Write value of current element in Destination array to variable.
        cValue = Dest(i, 1)
        ' Test for error value...
        If Not IsError(cValue) Then
            ' Test for empty value...
            If Not IsEmpty(cValue) Then
                ' Split Current Destination Value to Current Array of Values.
                cArray = Split(cValue, Delimiter)
                ' Loop through elements of Current Array of Values.
                For n = 0 To UBound(cArray)
                    cVal = cArray(n)
                    On Error Resume Next
                    cVal = CLng(cVal)
                    On Error GoTo 0
                    If IsNumeric(cVal) Then
                        ' Attempt to find a match in Source Lookup Array.
                        cMatch = Application.Match(cVal, Source(1), 0)
                        ' Test it found...
                        If IsNumeric(cMatch) Then
                            ' Write matching element from
                            ' Source Result Array to current element
                            ' in Current Array of Values.
                            cArray(n) = Source(2)(cMatch, 1)
                        End If
                    End If
                Next n
                ' Replace current element in Destination Array
                ' with joined elements of Current Array of Values.
                Dest(i, 1) = Join(cArray, Delimiter)
            End If
        End If
    Next i
    
    ' Write values from Destination Array to destination range.
    rng.Value = Dest
    
End Sub


Function defineNonEmptyRange( _
    FirstRowRange As Range) _
As Range
    ' Validate First Row Range.
    If Not FirstRowRange Is Nothing Then
        Dim cel As Range
        With FirstRowRange
            ' Attempt to define Last Non-Empty Cell Range.
            Set cel = .Resize(.Worksheet.Rows.Count - .Row + 1).Find( _
                What:="*", _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious)
            ' Validate Last Non-Empty Cell Range.
            If Not cel Is Nothing Then
                ' Define Non-Empty Range.
                Set defineNonEmptyRange = .Resize(cel.Row - .Row + 1)
            End If
        End With
    End If
End Function

Function getColumnRange( _
    SourceRange As Range, _
    Optional ByVal nthColumn As Long = 1) _
As Variant
    If Not SourceRange Is Nothing Then
        Dim Data As Variant
        With SourceRange.Columns(nthColumn)
            If .Cells.Count > 1 Then
                Data = .Value
            Else
                ReDim Data(1 To 1, 1 To 1)
                Data(1, 1) = .Value
            End If
        End With
        getColumnRange = Data
    End If
End Function