VBA Поиск значения в столбце в другом столбце, если не найден, показать, который, если найден, скопировать значение смещения для смещения ввода - PullRequest
Новая
       24

VBA Поиск значения в столбце в другом столбце, если не найден, показать, который, если найден, скопировать значение смещения для смещения ввода

0 голосов
/ 11 октября 2018

Можете ли вы помочь мне создать скрипт VBA, который будет искать ячейки значений в столбце Sheet1 H: H (каждая строка с данными), если он найдет значение на листе 2 H: H, он скопирует смещение -6 из листа 1 иВставьте смещение -6 на листе 2.

Если он ничего не найдет, он скажет мне, какие значения он не нашел.

Это то, что у меня так получается, работает, но не оптимально, во-первых, яне получает информацию о найденных значениях «НЕ», и если он не найден, он все равно просто перезапишет и скопирует этот элемент. 

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim oCell As Range


Dim i As Long
i = 2

Set ws1 = ThisWorkbook.Sheets("Data")
Set ws2 = ThisWorkbook.Sheets("Mellomlagring")


Do While ws1.Cells(i, 1).Value <> ""
    Set oCell = ws2.Range("H:H").Find(what:=ws1.Cells(i, 8))
    If Not oCell Is Nothing Then ws1.Cells(i, 2) = oCell.Offset(0, -6)
    i = i + 1
Loop

Set ws1 = Nothing
Set ws2 = Nothing

Спасибо за вашу помощь

1 Ответ

0 голосов
/ 11 октября 2018

Попробуйте: 

Sub tgr()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim rSourceHCol As Range
    Dim rSourceHCell As Range
    Dim rDestHCol As Range
    Dim rFound As Range
    Dim sFirst As String
    Dim sNotFound As String

    Set wb = ActiveWorkbook
    Set wsSource = wb.Sheets("Sheet1")
    Set wsDest = wb.Sheets("Sheet2")
    Set rSourceHCol = wsSource.Range("H2", wsSource.Cells(wsSource.Rows.Count, "H").End(xlUp))
    Set rDestHCol = wsDest.Range("H2", wsDest.Cells(wsDest.Rows.Count, "H").End(xlUp))

    If rSourceHCol.Row < 2 Then
        MsgBox "No values present in column H of source sheet " & wsSource.Name
        Exit Sub
    ElseIf rDestHCol.Row < 2 Then
        MsgBox "No values present in column H of destination sheet " & wsDest.Name
        Exit Sub
    End If

    For Each rSourceHCell In rSourceHCol.Cells
        Set rFound = rDestHCol.Find(rSourceHCell.Value, rDestHCol.Cells(rDestHCol.Cells.Count), xlValues, xlWhole)
        If rFound Is Nothing Then
            sNotFound = sNotFound & Chr(10) & rSourceHCell.Value
        Else
            sFirst = rFound.Address
            Do
                rFound.Offset(, -6).Value = rSourceHCell.Offset(, -6).Value
                Set rFound = rDestHCol.FindNext(rFound)
            Loop While rFound.Address <> sFirst
        End If
    Next rSourceHCell

    If Len(sNotFound) = 0 Then
        MsgBox "All values from source data accounted for and updated in destination"
    Else
        MsgBox "The following values in the source data were not found in destination:" & sNotFound
    End If

End Sub
...