如果列是动态的，如何使用 Excel 中的标题名称范围获取数据？

Question

我这里有一个简单的表单，可以在输入 ID 时匹配数据。效果很好。然而，这些列是动态的/可互换的。我想做的是将

foundcell variable range

从列号设置为标题名称，这样每当列互换时，ID 在更新后仍然具有匹配的完整数据。

Sheet1 数据图像

文本数据

ID  Description 1   Description 2   Description 3   Description 4
1       Abc             123             Red             Yes
2       Def             456             Blue            Yes
3       Ghi             789             Orange          Yes
4       Jkl             0               Yellow          No

下面是 ID 2 的示例匹配数据。

VBA Excel 代码

Private Sub id_Change()
Dim id As Variant, rowcount As Integer, foundcell As Range
id = Me.id.value
    rowcount = ThisWorkbook.Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).row
        With ThisWorkbook.Sheets("Sheet1").Range("A1:A" & rowcount)
        Set foundcell = .Find(what:=id, LookIn:=xlValues)
          If Not foundcell Is Nothing Then                
                desc1.value = .Cells(foundcell.row, 2) 'I would like to name this as Description 1
                desc2.value = .Cells(foundcell.row, 3) 'I would like to name this as Description 2
                desc3.value = .Cells(foundcell.row, 4) 'I would like to name this as Description 3
                desc4.value = .Cells(foundcell.row, 5) 'I would like to name this as Description 4
            Else
                 desc1.value = ""
                 desc2.value = ""
                 desc3.value = ""
                 desc4.value = ""
            End If
        End With
End Sub

请指教。谢谢..

Answer 1

你可以使用字典做这样的事情：

Private Sub id_Change()
    Dim id As Variant, headers As Object, ws As Worksheet, m
    id = Me.id.Value
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set headers = AllHeaders(ws, 1) 'get column headers from first row
    m = Application.Match(id, ws.Columns(headers("ID")), 0)
    If Not IsError(m) Then
        With ws.Rows(m)
            desc1.Value = .Cells(headers("Description 1"))
            desc2.Value = .Cells(headers("Description 2"))
            desc3.Value = .Cells(headers("Description 3"))
            desc4.Value = .Cells(headers("Description 4"))
        End With
    Else
        desc1.Value = ""
        desc2.Value = ""
        desc3.Value = ""
        desc4.Value = ""
    End If
End Sub

'Return a Dictionary mapping all headers on row `rw` of sheet `ws`
'   to their column positions
Function AllHeaders(ws As Worksheet, rw As Long) As Object
    Dim dict As Object, v As String, c As Range
    Set dict = CreateObject("scripting.dictionary")
    dict.comparemode = 1 'vbTextCompare: case-insensitive
    For Each c In ws.Range(ws.Cells(rw, 1), ws.Cells(rw, Columns.Count).End(xlToLeft)).Cells
        v = c.Value
        If Len(v) > 0 Then dict.Add v, c.Column 'map headers to column number
    Next c
    Set AllHeaders = dict
End Function