Перенос определенных данных с одного листа на другой и удаление дубликатов - PullRequest
Новая
       8

Перенос определенных данных с одного листа на другой и удаление дубликатов

0 голосов
/ 24 октября 2019

У меня есть Excel, где у меня есть два листа, лист "один" и лист "два". В моем «тесте» на листе 1 есть 4 столбца от A до D. Если столбцы A и B совпадают с новой строкой, макрос удаляет более старую строку. На листе 2 есть значения для разных чисел для столбца A. Мне нужен макрос, который переносит эти значения в соответствующие номера столбца A в столбец D. Надеюсь, я объясню это ясно :) Вот пример моего «теста» Excel. 

     One             Two
   A  B  C  D      
1  2  2  2         2 = work
2  3  3  3         3 = fun
3  2  2  2
4  1  1  1

 After macro ----->

       One
    A  B  C  D
 1  3  3  3  fun
 2  2  2  2  work
 3  1  1  1

Теперь макрос удалил строку 2 и передал правильные данные в столбец D.

Вот что я уже пробовал: (Самая большая проблема - передача данных с листа 2 на лист 1)

Private Sub CommandButton1_Click()

Dim lastrow As Long, erow As Long
lastrow = Worksheets("one").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrow

Worksheets("two").Cells(i, 1).Copy
erow = Worksheets("two").Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("two, work").Paste Destination:=Worksheets("one").Cells(erow + 1, 5)

Worksheets("two").Cells(i, 2).Copy
Worksheets("two, fun").Paste Destination:=Worksheets("one").Cells(erow + 1, 5)

Next i

With Columns("A:B")
    .Sort key1:=Range("A1"), Order1:=xlAscending, key2:=Range("B1"),   Order2:=xlDescending, Header:=xlGuess
    .RemoveDuplicates Columns:=1, Header:=xlGuess
End With


End Sub

Это всего лишь тест Excel, но в действительности более 2000 строк, поэтому, несмотря на то, что мой макрос работает неправильно, он очень медленный. Я нахожу это очень сложным, и я не знаю, как правильно перенести данные в соответствующие значения. Я ДЕЙСТВИТЕЛЬНО оценил бы любую помощь, которую я получаю. БЛАГОДАРЮ ВАС! :)

...