VLOOKUP将数据压缩到一个单元格中

Question

我尝试创建一个用户输入的宏，并将其缩短为缩写代码。假设用户已将数据输入表中：

宏将运行并输出基于此表的缩写代码（在这种情况下，输出＆＃34; BLK190_G16_WFUR12＆＃34;）：

Sub Abbreviated_Code()

'Counts number of partitions
Dim PartitionCount As Integer
PartitionCount = Application.CountIf("B16:B25", "*")

' VLOOKUP loop for as many times there are partition layers
    Let x = 0
    Let materialnum = 16 'First material listed at B16
    Do While x < PartitionCount
    abbrev = Application.VLookup(Range("B" & materialnum), info.Range("C2:D20"), 1, False)
    newCode = abbrev & Range("C" & materialnum)

    x = x + 1
    materialnum = materialnum + 1

    Range("E16") = Range("E16") & newCode & "_" 'Output string of text into cell E16
    Loop

End Sub

如果有人能帮我解决，我真的很感激。

Answer 1

稍微修改一下你的代码它现在有效，它有点乱，但是这段代码中也存在错误处理。您的数据需要位于C2＆amp; B16。

Sub Abbreviated_Code()

'Counts number of partitions
Dim PartitionCount As Integer
PartitionCount = Application.WorksheetFunction.CountIf(Range("B16:B25"), "*")

Range("E16") = ""
' VLOOKUP loop for as many times there are partition layers
    Let x = 0
    Let materialnum = 16 'First material listed at B16
    Do While x < PartitionCount

    If Not IsError(Application.Match(Range("B" & materialnum).Value, Range("D2:D10"), 0)) Then
        abbrev = Application.WorksheetFunction.Index(Range("C2:C10"), Application.WorksheetFunction.Match(Range("B" & materialnum).Value, Range("D2:D10"), 0))
    Else:
        GoTo skip:
    End If

    newCode = abbrev & Range("C" & materialnum)

    If Range("E16") = "" Then
        Range("E16") = newCode
    Else:
        Range("E16") = Range("E16") & "_" & newCode 'Output string of text into cell E16
    End If
skip:
    x = x + 1
    materialnum = materialnum + 1
    Loop

End Sub

Answer 2

Sub InputToAbbreviation()
    Dim References As Range, Materials As Range
    Dim reference, material As Range, code As String

    Set References = Range("C2:D20")
    Set Materials = Range("B16:B" & Range("B16").End(xlDown).Row)

    For Each material In Materials
        code = code & Application.VLookup(material, References, 2, False) & material.Offset(0, 1) & "_"
    Next

    Debug.Print Left$(code, Len(code) - 1) //Remove trailing '_'
End Sub

注意：

• 将您的代码表重新排序为第一列中的描述，第二列是
• 假设C2范围内的代码描述：D20
• 假设第16行中的用户输入材料和厚度（如代码所示）