Excel Makro: Finne duplikater i celler

[howieD]

Hei,

 

Jeg har en makro som nå søker i alle celler nedover i kolonne C i filen "Organisasjonsnumre.xls" etter celler med et identisk innhold i kolonne B i filen "Butikker.xls". Innholdet i hver celle nedover kolonne B i filen "Organisasjonsnumre.xls" er et organisasjonsnummer.

 

Dersom den finner et identisk treff vil ordet "Funnet", sammen med flere verdier fra filen "Butikker.xls" dukke opp i cellen rett til høyre for cellen med organisasjonsnummeret i filen "Organisasjonsnumre.xls".

 

Eks: "Funnet: 987654321(fra Organisasjonsnummer.xls) Ola Kiosk( fra Butikker.xls) og Jens Kebab(fra Butikker.xls) og Fisk 1000(fra Butikker.xls) og (osv...) ".

 

Strukturen er:

Innholdet i hver celle nedover i kolonne C i filen "Organisasjonsnumre.xls" er et organisasjonsnummer.

 

Innholdet i hver celle nedover i kolonne B i filen "Butikker.xls" er et organisasjonsnummer.

Innholdet i hver celle nedover i kolonne D i filen "Butikker.xls" er butikknavn.

Kolonne B kan ha 10 rader med samme organisasjonsnummer, men som har forskjellige butikknavn i kolonne D.

Eks:

987654321 Rema 1001

987654321 Rema 1002

987654321 Rema 1003

 

Jeg ønsker å hente ut alle butikkene og legge de inn i cellen til venstre for organisasjonsjummeret i filen "Organisasjonsnumre.xls.

 

Slik:

 

987654321 Rema 1001 Rema 1002 Rema 1003

 

 

Dette er den foreløpige makroen:

Sub Find_Matches()
   Dim CompareRange As Variant, x As Variant, y As Variant
   ' Angi CompareRange som området der du vil
   ' sammenligne utvalget.
   ' Set CompareRange = Range("C1:C5")
   ' Obs!    Hvis sammenligningsområdet finnes i en annen arbeidsbok
   ' eller et annet regneark, bruker du følgende syntaks:
    Set CompareRange = Workbooks("Team AmEx.xls"). _
      Worksheets("Ark1").Range("B2:B65536")
   '
   ' Gjenta gjennom hver celle i utvalget og sammenlign det med
   ' hver celle i CompareRange.
   For Each x In Selection

   If UCase(x) = "STOPP" Then
                 MsgBox "Ferdig"

                  Exit Sub

           End If

       For Each y In CompareRange



           If x = y Then x.Offset(0, 1) = "Funnet: " & y.Offset(0, -1) & " " & y.Offset(0, 2)

       Next y
   Next x
End Sub

 

 

Her er makroen som foreløpig bare klarer å legge inn kun 1 butikk i cellen til venstre for organisasjonsnummeret i "Organisasjonsnumre.xls".

Endret 18. mars 2011 av Haavard82

[Harald Staff]

Uten å forske for dypt i det; jeg mistenker at du er i ferd med å finne opp pivot-tabeller på ny. Test originalene først.

 

Beste hilsen Harald