Как скопировать и вставить уникальные данные по дате, когда даты повторяются?

Question

Я пытаюсь скопировать данные с одного листа на другой в соответствии с датами сопоставления, и пока я могу это сделать, но проблема в том, что самые последние данные за соответствующую дату перезаписывают все другие данные за эту же дату.

EG

Я хочу скопировать данные из sheet 2 column 1 (на основе даты в column 2)

Я хочу вставить эти данные в sheet 1 column 2 (на основе даты в column 1)

Как видно, только последнее число из sheet 2 column 1, соответствующее соответствующей дате, вставляется во ВСЕ соответствующие даты вsheet 1 column 2.

Вместо этого, если есть две даты, я хочу вставить два разных числа (от sheet 2 column 1) в sheet 1 column 2.

Мой оригинальный код выглядит следующим образом:

Sub Macroturnip()
'
' Macroturnip Macro
'

Dim Row As Double 'row is the row variable for the destination spreadsheet
Dim i As Date
Dim x As Long 'x is the row variable for the source spreadsheet


For Row = 1 To 825


    i = Sheets("1").Cells(Row, 1)

      If i <> DateSerial(1900, 1, 0) Then
        'DateSerial(1900, 1, 0) --> this is the default for no data in the field, i.e. i want to skip these

            For x = 2 To 450


                    If Sheets("2").Cells(x, 2) = Sheets("1").Cells(Row, 1) Then
                    Sheets("2").Select
                    Cells(x, 1).Select
                    Selection.Copy
                    Sheets("1").Select
                    Cells(Row, 2).Select
                    ActiveSheet.Paste

                    End If                                                                     

            Next x            

     End If         

Next Row


End Sub

Answer 1

• Рекомендуется избегать использования имен переменных, которые уже представляют что-то в коде, например: Row.

• Row число должно бытьтип integer / long

• Вы должны объявить и присвоить свои таблицы переменным

• Большая часть кода в VBA может быть написана без использования .Selectхотя иногда вам это может понадобиться, это не один из тех моментов ... и вам следует избегать любой ценой использования его во вложенном цикле.Например:

Sheets("2").Select
Cells(x, 1).Select
Selection.Copy

Может быть легко переписан следующим образом:

Sheets("2").Cells(x, 1).Copy

Для этого может потребоваться более совершенная логика, но на основе ваших снимков экрана это работает:

Sub Macroturnip()
'
' Macroturnip Macro
'

Dim wsDst As Worksheet: Set wsDst = ActiveWorkbook.Sheets("1")
Dim lRowDst As Long: lRowDst = wsDst.Cells(wsDst.Rows.Count, 1).End(xlUp).Row

Dim wsSrc As Worksheet: Set wsSrc = ActiveWorkbook.Sheets("2")
Dim lRowSrc As Long: lRowSrc = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row

Dim rngFind As Range
Dim Rs As Long, Rd As Long 'row is the row variable for the destination spreadsheet


    For Rd = 2 To lRowDst

        If wsDst.Cells(Rd, 1) <> "" Then
        'DateSerial(1900, 1, 0) --> this is the default for no data in the field, i.e. i want to skip these
            For Rs = 2 To lRowSrc
                If wsDst.Cells(Rd, 1) = wsSrc.Cells(Rs, 2) Then

                    Set rngFind = wsDst.Range("B2:B" & Rd).Find(wsSrc.Cells(Rs, 1), Lookat:=xlWhole)
                    If rngFind Is Nothing Then
                        wsDst.Cells(Rd, 2) = wsSrc.Cells(Rs, 1).Value
                        Exit For 'No need to keep checking, move on
                    End If
                    Set rngFind = Nothing
                End If
            Next Rs
        End If
    Next Rd
End Sub

PS: я предположил, что к Sheets("2") вы фактически ссылались на лист с именем 2, а не Sheet2 или Sheets(2), которые хотя и выглядят одинаково, но это не одно и то же.