VBA Excel Искать значения между 2 динамическими диапазонами - PullRequest
0 голосов
/ 02 февраля 2019

Для каждой ячейки в myRange я хочу проверить диапазон значений в Sheet2, и если значения в Sheet2 найдены в myRange, то для соответствующей строки я хочу поместить значение из столбца A в столбец E * 1001.*

В нынешнем виде я могу искать только одно значение из Sheet2 («A1»).При попытке расширить этот диапазон я получаю ошибки.

Есть ли способ сделать диапазон в Sheet2 динамическим, пожалуйста?

Sub Find_values()

    Dim myRange As Range
    Dim Cell As Range
    Dim LR As Long

    LR = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
    Set myRange = Sheets(1).Range("B1:B" & LR)

    For Each Cell In myRange

    If Cell.Value = Sheets(2).Range("A1").Value Then Cell.Offset(0, 3) = Cell.Offset(0, -1).Value


    Next Cell

End Sub

enter image description here

enter image description here

enter image description here

enter image description here

Ответы [ 2 ]

0 голосов
/ 02 февраля 2019

Как и предлагали другие, вы можете просто вложить два цикла For Each.

Sub Find_values()

    Dim myRange1 As Range
    Dim myRange2 As Range
    Dim Cell1 As Range
    Dim Cell2 as Range

    Set myRange1 = Sheets(1).Range(range("B1"),range("B1").end(xlDown))
    Set myRange2 = Sheets(2).Range(range("A1"),range("A1").end(xlDown)) 'This range is also dynamic and will adapt to teh number of entries you ahve in Sheet2

    For Each Cell1 In myRange1
    For Each Cell2 In myRange2

    If Cell1.Value2 = Cell2.Value2 Then
        Cell1.Offset(0, 3) = Cell1.Offset(0, -1).Value2
        Exit for 'Save you some useless processing time since the entry has already been found
    end If

    Next Cell2
    Next Cell1

End Sub

Примечание.Примечание. Я также изменил ваш оператор .value на .value2, который в некоторых случаях будет лучше работать в зависимости от типа данных, используемых в вашей ячейке.

0 голосов
/ 02 февраля 2019

Выполните следующие действия:

Преобразование данных на листе 1 в структурированную таблицу Excel:

1 - выберите диапазон от ячейки масштаба до последней объединенной ячейки

2- Нажмите на ленту «Домой» |"Стили" |«Формат как таблица» |

3- Установите флажок «Моя таблица содержит заголовки» (отметьте его)

4- Запишите имя таблицы (при выборе одной ячейки внутри таблицы,посмотрите на ленту «Инструменты таблицы» | «Имя таблицы»

5- Повторите предыдущие шаги для данных на Листе 2

6 - Добавьте следующий код в модуль VBA:

Sub LookupValues()

    ' Define object variables
    Dim sourceSheet As Worksheet
    Dim sourceTable As ListObject
    Dim sourceCell As Range

    Dim dataSheet As Worksheet
    Dim dataTable As ListObject



    ' Define other variables
    Dim sourceSheetName As String
    Dim sourceTableName As String

    Dim dataSheetName As String
    Dim dataTableName As String


    ' >>>>Customize this<<<<<
    sourceSheetName = "Sheet2"
    sourceTableName = "Table2"
    dataSheetName = "Sheet1"
    dataTableName = "Table1"

    ' Initialize worksheets
    Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)
    Set dataSheet = ThisWorkbook.Worksheets(dataSheetName)

    ' Initialize source table
    Set sourceTable = sourceSheet.ListObjects(sourceTableName)
    Set dataTable = dataSheet.ListObjects(dataTableName)

    ' Loop through every cell in sourceSheet
    For Each sourceCell In sourceTable.DataBodyRange.Columns(1).Cells
        ' >>>>Customize this<<<<<
        ' In the following code:
        ' Offset(0, 4) -> 4 stand for 4 columns after column A
        ' Index(dataTable.DataBodyRange.Columns(1) -> 1 stands to return the first column of the data table
        ' Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2) -> 2 stands to look in the second column of the data table
        If Not IsError(Application.Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2), 0)) Then
            sourceCell.Offset(0, 4).Value = Application.Index(dataTable.DataBodyRange.Columns(1), Application.Match(sourceCell.Value, dataTable.DataBodyRange.Columns(2), 0))
        End If

    Next sourceCell


End Sub

6- Настройте код в соответствии со своими потребностями

7- Протестируйте его и дайте нам знать, если он работает. Надеюсь, это поможет!

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