VBA Vlookup диапазона дат в разных листах - PullRequest
0 голосов
/ 13 февраля 2019

У меня нулевой опыт программирования и я новичок в VBA, поэтому я даже не знаю основ, но делаю это.У меня есть Рабочая тетрадь с несколькими листами.Тот, который меня волнует, - это 2 листа, которые называются DG и Asp.В DG есть кнопка, которая получает необработанные данные с сервера и заполняет листы (несколько столбцов даты со значением данных в соседних ячейках).У Asp есть кнопка, которая также получает данные, но в среднем за 30 дней, каждый день в месяце (столбцы A в Asp).Это тот же случай с листом DG, но у DG есть данные за разные даты в месяце, потому что это не 30-дневная тяга.Итак, это устанавливает изображение для вас, теперь я хочу создать кнопку с кодом, который может проходить через столбец даты в DG и сопоставлять его с датой из даты asp, и, если есть совпадение, затем скопировать ивставьте значения соседних ячеек в DG в asp.

Это то, что я имею до сих пор с поисками в Интернете, показывая только vlookup для отдельных столбцов, которые я хочу заполнить в Asp, но он не работает

Private Sub CommandButton2_Click()
Dim results As Double
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lrow As Long
Dim i As Long

Set ws1 = Worksheets("DG")
Set ws2 = Worksheets("Asp")
lrow = Worksheets("Asp").Range("A5", ws2.Range("A5").End(xlUp)).Rows.Count
For i = 5 To lrow
On Error Resume Next
        result = Application.WorksheetFunction.VLookup((ws2.Range("A5" & i)), (ws1.Range("A11:B200")), 2, True)
              ws2.Range("AG5").Value = result
    If Err.Number = 0 Then
       End If
       On Error GoTo 0

       
Next i
 
End Sub

DG [1]: https://i.stack.imgur.com/ZrwfZ.jpg
ASP [2]: https://i.stack.imgur.com/tTsl0.jpg

1 Ответ

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

Это пятница, вот, пожалуйста, на что посмотреть и изучить.Мне жаль, что я не использовал Vlookup, я потратил слишком много времени на погоню за призраками.Возможно, другие добились большего успеха, я думаю, что мне не нравится Vlookup, если он не дает точного соответствия, иногда он выбирает соседний ряд и бросает все в суматоху.

Вот оно:

Option Explicit

Private Sub CommandButton2_Click()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lrow2 As Long
Dim lrow1 As Long
Dim firstDataRow As Double

Dim matchRange As Range
Dim matchRow As Long

Dim i As Long

'Set up your Worksheet variables
Set ws1 = ThisWorkbook.Worksheets("DG")
Set ws2 = ThisWorkbook.Worksheets("Asp")

'You used A5 several times, so I will assume dates are in Col A and start at row 5
'Set your row with first data, maybe you need two, if they are the same on both sheets you don't
firstDataRow = 5

'find the last row on each sheet, using column A, the date col
lrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lrow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

'In your mind you now have two data ranges, one for each sheet, rows 5-last dat rows

'Pick one sheet, the one with less dates would be more efficient, you mention DG has less
'So this might be built backwards from what you are thinking, since we are iterating each row in the col
'You want to use the shrter call, IF you know its shorter (your comments)

'Loop through each row trying to find a match on your other sheet
For i = firstDataRow To lrow1

    If ws1.Cells(i, "A") <> "" Then 'Test for empty

        'Here is the premise of Find/Match over Vlookup
        Set matchRange = ws2.Range("A" & firstDataRow & ":A" & lrow2).Find(ws1.Cells(i, "A"))

        On Error Resume Next
        matchRow = matchRange.Row 'Returns row number or nothing

        If (Not matchRange Is Nothing) Then
            'we have a row number matched on Asp, for our search item on DG
            'perform the "Copy", this can be done differently but here I am going to introduce you to a way
            'that can later be used with offsets and col #s, so that you may skip columns, data is not always adjacent
            ws2.Cells(matchRow, "E") = ws1.Cells(i, "B")
            ws2.Cells(matchRow, "F") = ws1.Cells(i, "C")
            ws2.Cells(matchRow, "G") = ws1.Cells(i, "D")
        Else 'DO NOTHING
        End If
    Else 'DO NOTHING
    End If

Next i

MsgBox "Search and Copy is complete.", vbInformation, "Completed"

End Sub

В этом простом проекте можно еще много рассказать о том, чтобы сделать это более пуленепробиваемым.Но это хорошее начало для того, где вы находитесь.

enter image description here

enter image description here

Ура!Удачного кодирования!- WWC

...