使用变量搜索2D表并查找其交集值

问题描述 投票:0回答:1

所以我有一个2D数据表(字母和变量相互绘制),我试图用一个简单的3列表(字母,变量,值)中的值搜索轴,并找到相交的值并打印出来简单表的值col。

我的表的快照如下:

enter image description here

我可以通过对值进行硬编码来实现,但我正在努力使其适应变量,因为我对使用VBA有点新意。工作硬编码版本如下:

Sub Finder()
    Dim var As String
    Dim ltr As String
    var = Range("T2").value
    ltr = Range("S2").value

    Dim variable As String
    Dim letter As String

    Dim col As Range
    Dim row As Range

    variable = var
    letter = ltr

    Set col = Range("A1:AAA1").Find(what:=variable).EntireColumn
    Set row = Range("A2:A100").Find(what:=letter).EntireRow

    Dim value As String
    MsgBox Intersect(col, row).value
    Range("U2") = Intersect(col, row).value
End Sub

我现在尝试对变量做同样的代码如下:

Sub Finder()
    Dim rng As Range
    Dim rngltr As Range
    Dim rngvar As Range
    Dim rngval As Range
    Dim cell As Range
    Dim dcol As Range
    Dim drow As Range
    Dim row As Range

    Dim var As String
    Dim ltr As String
    Dim val As String

    Set rng = Range("tblValues")
    Set rngltr = rng.Columns(1)
    Set rngvar = rng.Columns(2)
    Set rngval = rng.Columns(3)

    For Each row In rng.Rows
        For Each cell In row.Cells
            ltr = Range(row).Columns(1).value
            var = Range(row).Columns(2).value
            val = Range(row).Columns(3).value
            'row.Interior.Color = vbYellow

            Set dcol = Range("A1:AAA1").Find(what:=var).EntireColumn
            Set drow = Range("A2:A100").Find(what:=ltr).EntireRow

            Dim value As String
            MsgBox Intersect(dcol, drow).value
            Range(row).Columns(3) = Intersect(dcol, drow).value
        Next cell
    Next row
End Sub

在硬编码版本中,它可以很好地工作,但是通过添加循环的复杂性逐行和变量,我认为我在正确的轨道上,但我不太确定在同一时间。任何建议或指示我应该采取什么方式来解决这个问题,或者如果我这样做完全错误,有人会指出我正确的方向,

excel vba variables range
1个回答
1
投票

根据您的屏幕截图,试试这个。只需要遍历表的一列并使用OFFSET引用其他列。

Sub Finder()

Dim rng As ListObject, rng1 As Range
Dim dcol As Range
Dim drow As Range
Dim row As Range

Set rng = ActiveSheet.ListObjects("tblValues")
Set rng1 = rng.ListColumns(1).DataBodyRange 'easier to refer to table ranges in this way I think

For Each row In rng1 'loop through first column of tblValues
    Set dcol = Range("A1:AAA1").Find(what:=row.Offset(, 1))
    Set drow = Range("A2:A100").Find(what:=row)
    If Not dcol Is Nothing And Not drow Is Nothing Then 'always check values are found to avoid errors
        MsgBox Intersect(dcol.EntireColumn, drow.EntireRow).value
        row.Offset(, 2) = Intersect(dcol.EntireColumn, drow.EntireRow).value
    End If
Next row

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.