excel - 将多个值索引到单个单元格中

Question

我正在尝试从 Sheet(SOH) 获取库存数量，然后将它们更新到 Sheet(Report) soh 列。但是，我在将多个值索引到单个单元格中时遇到问题。我正在使用如下“Application.Index”代码，我们将不胜感激任何帮助!

Sub Fillstock_Test()

'Get qty, from SOH to Report'

Dim i, lr, sold As Long
Dim soh As Variant
Dim sku, soh_str As String

lr = Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    sku = Sheets("Report").Cells(i, "B").Value
    soh = Application.IfError(Application.Index(Sheets("SOH").Range("A:Z"), _
        Application.Match(sku, Sheets("SOH").Range("A:A"), 0), 2), 0)
    soh_str = ": " & soh  'Get SOH String


    Sheets("Report").Cells(i, "C").Value = soh_str

Next i

End Sub

Answer 1

VBA 查找:匹配带分隔符的单元格值

Sub Fillstock_Test()

    'Get qty, from SOH to Report'
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("SOH")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    Dim srgSKU As Range: Set srgSKU = sws.Range("A2", sws.Cells(slRow, "A"))
    Dim srgQTY As Range: Set srgQTY = srgSKU.EntireRow.Columns("B")
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("Report")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "B").End(xlUp).Row
    Dim drgSKU As Range: Set drgSKU = dws.Range("B2", dws.Cells(dlRow, "B"))
    Dim drgQTY As Range: Set drgQTY = drgSKU.EntireRow.Columns("C")
    
    ' Source
    Dim srIndex As Variant ' to read from srgQTY
    Dim sQTY As String
    ' Destination
    Dim dCell As Range
    Dim dSkuQty() As String ' read SKU, write QTY string
    Dim dSKU As String
    Dim dQTY As String
    Dim drIndex As Long
    Dim ds As Long
       
    For Each dCell In drgSKU.Cells
        drIndex = drIndex + 1 ' to write to drgQTY
        ' Split: replace SKU with matched QTY.
        dSkuQty = Split(CStr(dCell.Value), vbLf)
        For ds = 0 To UBound(dSkuQty)
            dSKU = dSkuQty(ds)
            If Len(dSKU) > 0 Then ' is not blank
                srIndex = Application.Match(dSKU, srgSKU, 0)
                If IsNumeric(srIndex) Then ' is found
                    sQTY = CStr(srgQTY.Cells(srIndex).Value)
                    dSkuQty(ds) = ":" & sQTY
                Else ' ('If IsError(srIndex) Then') ' is not found
                    dSkuQty(ds) = "sku not found" ' adjust!
                End If
            Else ' is blank
                dSkuQty(ds) = "sku is blank" ' adjust!
            End If
        Next ds
        ' Join.
        dQTY = Join(dSkuQty, vbLf)
        ' Write.
        drgQTY.Cells(drIndex).Value = dQTY
    Next dCell

End Sub