2013-12-03 3 views
2

Я пытаюсь сравнить два листа в одной книге. Мне нужно сопоставить значения в столбце A первого листа со столбцом A листа 2 и, если найдено совпадающее значение, скопируйте и вставьте значение из столбца E листа 2 в столбец E листа 1. Например:Excel VBA - Передача данных между листами

Sheet 1: A B C D E   Sheet 2: A B C D E 
     k 9 b 3      k d 3 d 6 
     j 2 d 4      m h 4 g 3 
     s 3 u 9      j e 8 a 9 
     i 4 s 6      s i 9 t 7 
     o 7 n 8      l b 10 s 9 
               i c 4 p 8 
               o l 0 n 9 

стал бы

Sheet 1: A B C D E 
     k 9 b 3 6 
     j 2 d 4 9 
     s 3 u 9 7 
     i 4 s 6 8 
     o 7 n 8 9 

код Сейчас я работаю с есть: Sub mergeCategoryValues ​​() Dim lngRow As Long

With ActiveSheet 

lngRow = .Cells(65536, 1).End(xlUp).Row 

    .Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes 
Do 

If .Cells(lngRow, 1) = Sheets("Sheet2").Cells(lngRow, 1) Then 
    .Cells(lngRow, 5) = Sheets("Sheet2").Cells(lngRow, 5) 
End If 

lngRow = lngRow - 1 

Loop Until lngRow < 2 

End With 

End Sub 

Мне нужно вытаскивать дубликаты независимо от случая. Это возможно?

Любая помощь приветствуется.

Заранее спасибо.

+4

Не подходит ли VLOOKUP или INDEX/MATCH? – pnuts

+0

VLOOKUP работал хорошо. Я пытался найти способ сделать то же самое с VBA, но я думаю, что это не стоит. Благодаря! – Texas2014

ответ

1

Я разработал код VBA:

Sub sof20355637MergeCategoryValues() 
    Dim i As Long, i2 As Long, lngRow As Long, lngRow2 As Long 
    Dim strKey As String 
    Dim wks1, wks2 As Worksheet 
    Dim objRange2 

    Set wks1 = Sheets("Sheet1") 
    Set wks2 = Sheets("Sheet2") 

    ' get mximum rows of each sheet: 
    lngRow = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row 
    lngRow2 = wks2.Cells(wks1.Rows.Count, 1).End(xlUp).Row 

    ' we loop on the first column of sheet1: 
    For i = 1 To lngRow 
    strKey = wks1.Range("A" & i) 
    Set objRange2 = wks2.Range("A:A").Find(strKey, Range("A1"), SearchDirection:=xlPrevious) 
    If (Not objRange2 Is Nothing) Then 
     i2 = objRange2.Row 
     wks1.Range("E" & i) = wks2.Range("E" & i2) 
    End If 
    Next 

    Set objRange2 = Nothing 
    Set wks1 = Nothing 
    Set wks2 = Nothing 

End Sub 

С некоторыми изображениями:

Лист1: Лист2:

enter image description here enter image description here

Merged Лист1:

enter image description here

0

Предполагая k на листе 1 в А1, то в Е1 Листа 1:

=VLOOKUP(A1,'Sheet 2'!A:E,5,0) 

и скопировал вниз костюм может служить, хотя и не VBA.

Смежные вопросы