Excel VBA Hitta lika värden i skilda arbetsböcker

[Tommy H]

Hej!

Jag har ett ws2 i vilket jag har ett antal löpande värden i kolumn L.

Dessa värdena vill jag matcha mot ws1 i en annan wb.

Det är dock inte självklart att värdet som finns på ws2 också finns på ws1.

Blir det däremot träff, så ska jag kopiera över ett antal celler från ws1 till ws2 och sedan så går vi till nästa rad på ws2.

Jag har snickrat på en Find-loop men fastnar på hur jag får olika Find-värden från ws2, och även hur jag kommer vidare då jag inte får någon träff på ws1.

Just nu känns det som om jag har rört ihop det mesta, men jag skickar iaf ett utdrag av koden:

 

        Set rnStart = ws2.Range("L9")

    With ws2.Range("L:L")
        
            Set C = .Find(rnStart, LookIn:=xlValues)
        If Not C Is Nothing Then
            firstAddress = C.Address

            Do
                C.Offset(0, 1) = i
                i = i + 1
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> firstAddress
        
                Set X = ws1.Range("AA:AA").Find(what:=C, LookIn:=xlValues, LookAt:= _
                xlWhole, MatchCase:=True)

                'här ska väl rimligen mina kopierings/inklistrings rader komma
            If X Is Nothing Then
                'Här vill jag att det plockas fram ett nytt värde från ws2 då det inte blev någon träff
            End If
        End If
    End With

 

/Tommy

[Monshi]

Oklart vad du vill göra egentligen, vad du vill kopiera.

Koden körs och "fungerar" men gör inte mycket mer än skriver in en räknare i tabellen på arbetsbok 2.

 

Inom

 Do
    C.Offset(0, 1) = i
    i = i + 1
    Set C = .FindNext(C)
 Loop While Not C Is Nothing And C.Address <> firstAddress

Har du, vi varje loop, en referens till träff på blad. Kan du få flera träffar då måste du agera inom loopen, om bara en bör den kanske skrivas om att bara söka en gång.

 

Min rekommendation är att dela upp koden i små delar. Skapa en funktion som givet en eller två referenser kopierar, gör det du vill. Testa att den fungerar.

Sedan lägga in ett anrop till denna i dit sök, där den ska vara. Dvs separerar logiken.

 

[Tommy H]

Hmmm...var jag så otydlig?

jag försöker att bli tydligare?

jag har alltså värden i kolumn L på ett blad och jag vill hitta motsvarande värde i kolumn AA på ett annat blad. Det kan dock vara så att värdet inte återfinns i kolumn AA på det andra bladet och då går vi vidare och tar nästa värde från kolumn L på det försa bladet. 

Blir det däremot ”träff” så skall jag hämta (kopiera) ett antal celler från det ena bladet till det andra, och sedan så fortsätter vi med nästa värde från L-kolumnen.

L-kolumnen innehåller typ 350 olika värden som alla ska gås igenom för åtgärd vid träff. Det finns dock som sagt också värden som inte ger någon träff och då ska vi bara ta nästa....

[Monshi]

Ah, ok

I lista 1 har du värden och data

 

I lista 2 har du en delmängd av värden (och data)

 

Du vill stega igenom lista 1, för varje värde i lista 1 söka i lista 2

Om träff, ska du kopiera den mängd data från lista 1 (samma rad) till lista 2. Säg närmsta fem cellerna till höger om kolumn L.

Om ingen träff, gör inget.

 

Finns det risk för flera träffar vid sök i lista 2?

Vad göra om det redan finns data i lista 2?

 

[Tommy H]

Jepp!

Ja, jag vill stega igenom lista 1, för varje värde i lista 1 söka i lista 2.

men det är från lista 2 som jag kopierar till lista1

det är på samma rad som jag hämtar cellerna, dock till vänster om vilket inte är så viktigt just nu.

nä det finns en enda unik träff i lista 2. (Det kan dock vara så att det inte blir träff i lista2 också).

Det finns värden redan i lista 1 som skall skrivas över.

det som kopieras ska kopieras fullt ut för att vara länkat till lista 2.

[Monshi]

Och vi kan inte nöja oss med formler, värden måste kopiera?

 Dvs något som detta:

Sub mySearch()
    Dim rnStart As Range
    Dim c As Range
    Set rnStart = Blad1.Range("A3")
    Do
        With Blad1.Range("L3:L10")
            
            Set c = .Find(rnStart, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
               ' vi har en träff
                rnStart.Offset(0, 1).Resize(1, 2).Value = c.Offset(0, 1).Resize(1, 2).Value
            End If
        End With
        Set rnStart = rnStart.Offset(1, 0)
    Loop Until rnStart.Value = ""
    

Exempelvis.

Set rnStart, loopen, kan man göra om till en for-each och koden kan bli snyggare om du formaterar det som tabeller.
 

Dim listaEtt As Range
    Dim c, myCell As Range

    Set listaEtt = Blad1.ListObjects("Tabell1").ListColumns("ID").DataBodyRange
    For Each myCell In listaEtt.Cells
        With Blad1.ListObjects("Tabell2").ListColumns("ID").DataBodyRange
            
            Set c = .Find(myCell, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
               ' vi har en träff
                myCell.Offset(0, 1).Resize(1, 2).Value = c.Offset(0, 1).Resize(1, 2).Value
            End If
        End With
    Next myCell

Och ifall tabellerna ser olika ut kan man putta in data i specifik kolumn om man vill.

 

[Tommy H]

Oj, blev det så avancerat?

Ja då hade jag aldrig löst det själv!

stort tack!