VB code om 2 lijsten te vergelijken en actie te ondernemen.

[SjorsH]

Mensen,

Aller eerst wil ik jullie allemaal bedanken omdat ik veel gebruik van dit forum maak. Het heeft mij al veel plezier (en oplossingen) gebracht.

Echter nu heb ik een vraagstuk waar ik op stuk loop.

Ik heb in excel 2 lijsten:

Blad1

Artikel (en diverse niet voor dit vraagstuk van belangzijnde velden)
1234567
pa23453
22234

(dit is dus een lijst met cijfer en cijfer/letter codes van verschillende lengtes)

Blad2

Artikel Hoeveelheid
111111 2
112112 5
112112 10
134411 809
1234567 62
1234567 89

(waarbij artikel een lijst is met cijfer en cijfer/letter codes van verschillende lengtes)

Nu wil ik in blad1 achter de artikel nummers de totale hoeveelheid van de artikelen hebben.

Dus ik ben op zoek naar een code die:

In blad1 uit de range A2:A523 per artikel, kijkt of deze in blad2 voorkomt, daarna moet als een artikel voorkomt de hoeveelheid in blad1 (in de rij van het betreffende artikel)worden neergezet. Extra moeilijkheid is dat een artikel in blad2 meerdere keren kan voorkomen en dus ook meerdere hoeveelheden kan hebben.

Ik heb gezocht en kan een topic vinden over het maken van een lijst doorzoek functie maar hetgeen ik maak werkt absoluut niet en ik zit daardoor op het verkeerde spoor.

Ik hoop dat jullie me kunnen helpen en ik kijk uit naar jullie reacties.

(ik heb geprobeert om het te uploaden maar het bestand is te groot.)

 

[Relleboer]

Onderstaande code verglijkt in twee werkboeken een lijst en als gegevens uit werkboek 1 in de lijst van werkboek 2 staan vult hij in een kolom yes in. Dus herschrijf deze macro een beetje en je hebt wat je zocht.

Sub ControlePreRegistered()

Application.ScreenUpdating = False
file = Application.GetOpenFilename("Alle bestanden (*.*),*.*")
    If file = False Then Exit Sub
     Workbooks.Open Filename:=file
     Workbooks(1).Activate
     
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Macro is de lijsten aan het vergelijken!"
 For Each cl In Workbooks(1).Sheets(1).Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Offset(, 6).SpecialCells(xlCellTypeConstants)
    Next
            For Each cl In Worksheets(1).Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Offset(, 6).SpecialCells(xlCellTypeConstants)
                 Set c = Workbooks(2).Sheets(1).Columns(2).Find(cl.Value, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        cl.Offset(, -1) = "Yes"
                    End If
            Next
                        Workbooks(2).Close False
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
            
End Sub

 

[snb]

Ik dacht aan deze:

Sub vergelijk()
  sq=sheets(1).range("[COLOR="Teal"]A1:B523[/COLOR]")
  st=sheets(2).range("[COLOR="teal"]A1:B200[/COLOR]")
  sn=application.worksheetfunction.transpose(Sheets(2).range("[COLOR="teal"]A1:A200[/COLOR]")
  c0=join(sn,"|")
  for j=1 to ubound(sq)
    do until instr("|" & c0 & "|" ,"|" & sq(j,1) & "|")=0
      y=ubound(split(left(c0,instr("|" & c0 & "|","|" & sq(j,1) & "|")),"|"))
      sq(j,2)=sq(j,2)+st(y,2)
      sn(y)=""
      c0=join(sn,"|")
    Loop
  Next
  sheets(1).range("[COLOR="teal"]A1:B523[/COLOR]")=sq
End Sub

 

[SjorsH]

Aller eerst hartelijk bedankt voor de reacties!

Onderstaande code verglijkt in twee werkboeken een lijst en als gegevens uit werkboek 1 in de lijst van werkboek 2 staan vult hij in een kolom yes in. Dus herschrijf deze macro een beetje en je hebt wat je zocht.

Sub ControlePreRegistered()

Application.ScreenUpdating = False
file = Application.GetOpenFilename("Alle bestanden (*.*),*.*")
    If file = False Then Exit Sub
     Workbooks.Open Filename:=file
     Workbooks(1).Activate
     
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Macro is de lijsten aan het vergelijken!"
 For Each cl In Workbooks(1).Sheets(1).Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Offset(, 6).SpecialCells(xlCellTypeConstants)
    Next
            For Each cl In Worksheets(1).Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Offset(, 6).SpecialCells(xlCellTypeConstants)
                 Set c = Workbooks(2).Sheets(1).Columns(2).Find(cl.Value, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        cl.Offset(, -1) = "Yes"
                    End If
            Next
                        Workbooks(2).Close False
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
            
End Sub

Hier moet ik de yes aanpassen, waarin moet ik deze aanpassen?
En ik zie niet hoe deze afvangt dat er in de Blad2 dezelfde waardes staan. Dus een artikel dat 2 keer in blad2 staat waarbij er meerdere hoeveelheden zijn.

Hoe moet ik dat dan afvangen?

Ik dacht aan deze:

Sub vergelijk()
  sq=sheets(1).range("[COLOR="Teal"]A1:B523[/COLOR]")
  st=sheets(2).range("[COLOR="teal"]A1:B200[/COLOR]")
  sn=application.worksheetfunction.transpose(Sheets(2).range("[COLOR="teal"]A1:A200[/COLOR]")
  c0=join(sn,"|")
  for j=1 to ubound(sq)
    do until instr("|" & c0 & "|" ,"|" & sq(j,1) & "|")=0
      y=ubound(split(left(c0,instr("|" & c0 & "|","|" & sq(j,1) & "|")),"|"))
      sq(j,2)=sq(j,2)+st(y,2)
      sn(y)=""
      c0=join(sn,"|")
    Loop
  Next
  sheets(1).range("[COLOR="teal"]A1:B523[/COLOR]")=sq
End Sub

Jouw antwoord code kom ik niet heel goed uit. Ik zie niet wat er in welk veld wordt ingevoerd en dus hoe de code werkt.

Ik begrijp dat het een gebrek aan code ervaring is van mijn kant, maar zou je het eea kunnen toelichten?

 

[SjorsH]

http://www.helpmij.nl/forum/showthread.php?t=392891

Daar heb ik een andere oplossing bedacht om het vraagstuk op te lossen.

Ik wil jullie allen bedanken voor de gedane moeite.