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

问：

我这里有一个简单的表格，在输入 ID 时匹配数据。它工作正常。但是，这些列是动态的/可互换的。我想做的是将从列号设置为标题名称，以便每当列互换时，ID 在更新后仍然具有匹配的完整数据。foundcell variable range

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

请指教。谢谢。。

Excel VBA 标头范围

Private Sub id_Change()
    Dim id As Variant, headers As Object, ws As Worksheet, f As range
    id = Me.id.Value
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set headers = AllHeaders(ws, 1) 'get column headers from first row
    Set f = ws.Columns(headers("ID")).Find(id, Lookat:=xlWhole, _
                                             Lookin:=xlValues)
    If Not f Is Nothing Then
        With f.EntireRow
            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.  Assumes all headers are unique.
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

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

How to get data using header name ranges in Excel in case columns are dynamic?

评论

评论