Поиск 2D-таблицы с переменными и найти их значение пересечения - PullRequest
0 голосов
/ 08 апреля 2019

Итак, у меня есть двумерная таблица данных (буквы и переменные, нанесенные друг на друга), и я пытаюсь найти на обеих осях значения, взятые из простой таблицы из 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

в версии с жестким кодом она работает отлично, но сдобавляя сложность цикла, чтобы идти строка за строкой и переменных, я думаю, что я на правильном пути, но я не слишком уверен в то же время.Любой совет или указание о том, как мне следует подходить к этому или если я делаю это совершенно неправильно, может кто-то направить меня в правильном направлении,

1 Ответ

1 голос
/ 08 апреля 2019

На основании вашего скриншота попробуйте это.Необходимо только пройти через один столбец вашей таблицы и ссылаться на другие столбцы, используя 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...