Как перебрать различные ячейки и вернуть значение в другой таблице - PullRequest
1 голос
/ 19 апреля 2019

Ячейки C8 и C9 в Рабочем листе «Карты Google» имеют точки захвата и высадки. Расстояние рассчитывается и показывается в C18. На рабочем листе «Лист 2» также есть столбец A с точками захвата и строка 1 с соответствующим выпадающим списком.

Я хочу написать код VBA, который будет проходить по циклу и ссылаться на каждый элемент «лист 2» на «Карты Google», а затем возвращать их соответствующие расстояния.

Sub Distance()
'
' Distance Macro
' To populate distance
'
' Keyboard Shortcut: Ctrl+Shift+D
'
    Sheets("Google maps").Select
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "=Sheet2!R[-6]C[-2]"
    Range("C9").Select
    ActiveCell.FormulaR1C1 = "=Sheet2!R[-8]C[-1]"
    Sheets("Sheet2").Select
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "='Google maps'!R[16]C[1]"
    Range("B3").Select
End Sub

1 Ответ

0 голосов
/ 21 апреля 2019

Это должно делать то, что вам нужно. Убедитесь, что вы проверили это на копии своей таблицы, прежде чем использовать ее.

Sub double_lookup()

    PickUp = ThisWorkbook.Sheets(1).Range("C8").Value
    dropoff = ThisWorkbook.Sheets(1).Range("C9").Value
    distance = ThisWorkbook.Sheets(1).Range("C18").Value

    lastrow = ThisWorkbook.Sheets(2).Cells(ThisWorkbook.Sheets(2).Rows.Count, "A").End(xlUp).Row
    Set Rng = ThisWorkbook.Sheets(2).Range("A1:A" & lastrow)

    xindex = ""
    Count = 1
    For Each cell In Rng
        If cell.Value = PickUp Then
            xindex = Count
            Exit For
        End If

        Count = Count + 1
    Next cell

    yindex = ""
    lastcol = ThisWorkbook.Sheets(2).Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    For i = 1 To lastcol
        If ThisWorkbook.Sheets(2).Cells(1, i).Value = dropoff Then
            yindex = i
            Exit For
        End If

    Next i

    If xindex = "" Or yindex = "" Then
        MsgBox ("pickup or dropoff not found in sheet 2")
    Else
        ThisWorkbook.Sheets(2).Cells(xindex, yindex).Value = distance
    End If

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...