• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA om data van andere tabbladen samen te voegen

Status
Niet open voor verdere reacties.
Zoiets.
Code: 
Sub Artikelnummers()
Dim sv, ws As Worksheet, dict As Object, i As Long
Set dict = CreateObject("Scripting.Dictionary")
For Each ws In Sheets
  If Left(ws.Name, 4) <> "Week"[COLOR=#0000ff] And ws.Name <> "26-11" And ws.Name <> "28-11"[/COLOR] Then
    sv = ws.Cells(1).CurrentRegion.Resize(, 10)
        For i = 2 To UBound(sv)
          dict(sv(i, 2)) = Application.Index(sv, i, Array(1, 2, 3, 6, 7, 8, 9, 10))
        Next i
  End If
 Next ws
Worksheets("Week 48").Range("A2").Resize(dict.Count, 8) = Application.Index(dict.items, 0, 0)
End Sub
 
dat ziet er goed uit.
omdat ik zeker 40 bladen heb die niet klaar zijn zal ik een hele lange regel nodig hebben.
ik heb al eerder gemerkt dat ik dan een foutmelding krijg omdat de regel dan niet goed word 'afgewerkt'
kan je me daar nog bij helpen?
bvd
 
je kan een select case gebruiken, dat is korter
Code: 
    For Each ws In Sheets
        If Left(ws.Name, 4) <> "Week" Then
            Select Case ws.Name
                Case "26-11", "27-11", "28-11", "01-12"
                Case Else
                    sv = ws.Cells(1).CurrentRegion.Resize(, 10)
                    For i = 2 To UBound(sv)
                        dict(sv(i, 2)) = Application.Index(sv, i, Array(1, 2, 3, 6, 7, 8, 9, 10))
                    Next i
            End Select
        End If
    Next ws
Anders kan je ook "like" gebruiken als comparator, als er een bepaalde structuur zit in de te mijden werkbladen
of je kan in ieder te mijden werkblad in de cel AA1(als voorbeeld) iets schrijven als die gebruikt mag worden, bv. "klaar", dan check je daarop en dan hoef je niet telkens je macro aan te passen
 
Laatst bewerkt:
Wat bedoel je met "niet klaar zijn"?
Het is een leeg werkblad?
 
ik heb nu even de regel 'te' lang gemaakt en krijg de volgende foutmelding:
compileerfout:
verwacht: regelnummer of naam of instructie of
instructie einde
 
dit is toch een voorbeeld omdat mijn originele bestand te groot is.
 
cow18 zei:
je kan een select case gebruiken, dat is korter
Code: 
    For Each ws In Sheets
        If Left(ws.Name, 4) <> "Week" Then
            Select Case ws.Name
                Case "26-11", "27-11", "28-11", "01-12"
                Case Else
                    sv = ws.Cells(1).CurrentRegion.Resize(, 10)
                    For i = 2 To UBound(sv)
                        dict(sv(i, 2)) = Application.Index(sv, i, Array(1, 2, 3, 6, 7, 8, 9, 10))
                    Next i
            End Select
        End If
    Next ws
Anders kan je ook "like" gebruiken als comparator, als er een bepaalde structuur zit in de te mijden werkbladen
of je kan in ieder te mijden werkblad in de cel AA1(als voorbeeld) iets schrijven als die gebruikt mag worden, bv. "klaar", dan check je daarop en dan hoef je niet telkens je macro aan te passen
Klik om te vergroten...

eigenlijk heb ik jaartabbladen vanaf 1965 tot en met 2020. ik heb alleen nog maar de jaren 1965, 1966, 1967, 1968, 1969 klaar.
misschien is er een code bv om 1970 tm 2020 in 1 keer te mijden
 
En een reactie op #24?
 
HSV zei:
Wat bedoel je met "niet klaar zijn"?
Het is een leeg werkblad?
Klik om te vergroten...

dit is een voorbeeld bestand.
mijn origineel is geladen met 55 tabbladen die geladen zijn met gemiddeld 300 regels
deze moet ik nog verwerken, vandaar
 
Zet bv. in cel A1 "klaar" zonder de dubbele quotes voor de bladen die klaar zijn.
Code: 
Sub Artikelnummers()
Dim sv, ws As Worksheet, dict As Object, i As Long
Set dict = CreateObject("Scripting.Dictionary")
For Each ws In Sheets
  If Left(ws.Name, 4) <> "Week" Then
    sv = ws.Cells(1).CurrentRegion.Resize(, 10)
[COLOR=#0000ff]     if lcase(sv(1, 1)) = "klaar" then[/COLOR]
        For i = 2 To UBound(sv)
          dict(sv(i, 2)) = Application.Index(sv, i, Array(1, 2, 3, 6, 7, 8, 9, 10))
        Next i
[COLOR=#0000ff]    end if[/COLOR]
  End If
 Next ws
Worksheets("Week 48").Range("A2").Resize(dict.Count, 8) = Application.Index(dict.items, 0, 0)
End Sub
 
na een hoop zweet en tranen is dit hem geworden.
Harry bedankt voor al je hulp en cow 18 ook bedankt!

Code: 
Sub Artikelnummers()
Dim sv, ws As Worksheet, dict As Object, i As Long
Set dict = CreateObject("Scripting.Dictionary")
For Each ws In Sheets
  If Left(ws.Name, 4) <> "Week" Then
    sv = ws.Cells(1).CurrentRegion.Resize(, 10)
     If LCase(sv(1, 1)) = "uniek" Then
        For i = 2 To UBound(sv)
          dict(sv(i, 2)) = Application.Index(sv, i, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10))
        Next i
    End If
  End If
 Next ws
Worksheets("Week 48").Range("A2").Resize(dict.Count, 9) = Application.Index(dict.items, 0, 0)
End Sub
 
Graag gedaan Robert.
 
ik heb net een test uitgevoerd met het originele bestand en nu ben ik er achter gekomen dat het toch niet helemaal doet wat ik wil.
de code zoekt namelijk naar ALLE unieke waarden. maar dat mag alleen in de eerste kolom.
deze code wil ik sowieso behouden omdat het de juiste kolommen selecteerd
Code: 
dict(sv(i, 2)) = Application.Index(sv, i, Array(1, 3, 4, 5, 6, 7, 8, 9, 10))

ik hoop dat je nog wilt helpen ;-)
 
Natuurlijk,

Dat schreef ik al in een van mijn vorige berichten.
Je bedoelt de unieke waarden van kolom B waarschijnlijk.
Wat wil je zien als resultaat?

Plaats eens een bestand met de gegevens die je wilt zien in het eerste tabblad.
 
dank je,

ik bedoel de unieke waarde in kolom A.
in het eerste tabblad wil ik dan de volgende kolommen zien: A, C, D, E, F, G, H, I
eigenlijk heel simpel ;-)
 
Dit bedoel je?
Code: 
dict(sv(i, 1)) = Application.Index(sv, i, Array(1, 3, 4, 5, 6, 7, 8, 9))
 
perfect!!!
maar, helaas is er een kleine maar...
maar dat zal wel simpel op te lossen zijn
hij neemt ook de data over van kolom J
en dat mag niet
 
hier de code vanuit het origineel:
Code: 
Sub Artikelnummers()
Dim sv, ws As Worksheet, dict As Object, i As Long
Set dict = CreateObject("Scripting.Dictionary")
For Each ws In Sheets
  If Left(ws.Name, 9) <> "ranglijst" Then
    sv = ws.Cells(1).CurrentRegion.Resize(, 10)
     If LCase(sv(1, 1)) = "uniek" Then
        For i = 2 To UBound(sv)
          dict(sv(i, 1)) = Application.Index(sv, i, Array(1, 3, 4, 5, 6, 7, 8, 9, 10))
        Next i
    End If
  End If
 Next ws
Worksheets("ranglijst 2020").Range("A2").Resize(dict.Count, 9) = Application.Index(dict.items, 0, 0)
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan