Porównywanie kolumn w dwóch różnych arkuszach programu Excel i skoroszytach, a następnie umieszczanie pasującej wartości w innej kolumnie

Question

Mam dużo problemów z próbowaniem odgadnięcia tego makra, więc w tej chwili używam 2 arkuszy w skoroszycie; Chciałbym użyć dwóch różnych skoroszytów, ale to nie jest tak ważne jak problem. Aby wyjaśnić, kolumna Arkusz E jest numerem identyfikacyjnym, aw kolumnie Arkusz2 jest numerem identyfikacyjnym, teraz jeśli jakakolwiek wartość w Arkusz1 E odpowiada wartości w kolumnie A w Arkuszu2, potrzebuję makra do skopiowania odpowiedniej komórki z Arkusz 2 kolumny D. Więc zasadniczo, jeśli E5 (z arkusza 1) pasuje do A1 w Arkuszu 2, potrzebowałbym makra do wyprowadzenia arkusza D1 arkusza Sheet2 do arkusza F5 arkusza Arkusza1. Byłoby również miło usunąć wartości z kolumny Arkusz1, jeśli kolumna Arkusz E nie pasuje do wartości z kolumny Arkusz 2 A.

Mam trochę kodu, ale po prostu wkleja wartości z kolumny D arkusza D, jeśli wartość z kolumny Arkusz1 E odpowiada wartości z kolumny Arkusz2 A. Problem występuje, gdy wartości wklejone z Arkusza 2 są wklejane w kolumnie F arkusza 1, a wartości nie są dopasowane do poprawnej wartości, która była zgodna z Arkuszem2. Są po prostu dumbo. Więc jeśli kolumna Arkusz1 E było jak tego

Sheet1 Column E Sheet1 F 

1317    relays_120x120.jpg 
1319    Control%20boards_120x120 
1320    Control%20boards_120x120 

Sheet2 Column A    Sheet2 column D 
1317      relays_120x120 
1318      /relays_120x120 
1319     ebay/SingleRunOval 

Ale w rzeczywistości muszę je wszystkie równe i jeśli kolumna Arkusz1 E ma wartość, która isnt w kolumnie Sheet2, to nie umieścić odnośnik w Arkusz1 kolumnie F pozostawić pusty.

Oto kod mam

Sub FindMatches() 

    Dim oldRow As Integer 
    Dim newRow As Integer 
    Dim i As Integer 

    i = 1 

    For oldRow = 2 To 1170 
     For newRow = 1 To 1170 
      If Worksheets("Sheet1").Cells(oldRow, 5) = Worksheets("Sheet2").Cells(newRow, 1) Then 

       Worksheets("Sheet1").Cells(i, 6) = Worksheets("Sheet2").Cells(oldRow, 4) 


       i = i + 1 

       Exit For 
      End If 
     Next newRow 
    Next oldRow 


End Sub 

Answer 1

Brzmi jak można osiągnąć swój cel z funkcji WYSZUKAJ.PIONOWO. Dodaj tę formułę do Arkusz1 F1: =IFERROR(VLookup(E1,Sheet2!A:D,4,FALSE),"")

Ta formuła spowoduje skopiowanie komórki do arkusza 1, jeśli znaleziono dopasowanie, ale jeśli nie zostanie znaleziona, komórka pozostanie pusta.

Answer 2

Spróbuj użyć poniższego kodu. Właśnie zmodyfikowaniu kodu za pomocą funkcji StrComp

Sub FindMatches() 

    Dim oldRow As Integer 
    Dim newRow As Integer 
    Dim i As Integer 
    i = 1 
    For oldRow = 1 To 1170 
     For newRow = 1 To 1170 
      If StrComp((Worksheets("Sheet1").Cells(oldRow, 5).Text), (Worksheets("Sheet2").Cells(newRow, 1).Text), vbTextCompare) <> 0 Then 
       i = oldRow 
       Worksheets("Sheet1").Cells(i, 6) = " " 
       Else 
       Worksheets("Sheet1").Cells(i, 6) = Worksheets("Sheet2").Cells(newRow, 4) 
       i = i + 1 
       Exit For 
      End If 
     Next newRow 
    Next oldRow 

End Sub