inhoud van bestanden filteren en in één file samenvoegen

[Angela69]

Hallo,

Wie wil mij helpen met het maken van een macro of VB ?
Het probleem:
In bestand 'te-tellen' staan een aantal bestanden die dezelfde layout hebben maar het aantal regels steeds verschillend is. (b.v. bestand 1 en 2)
Van deze bestanden moeten alléén de rijen in het geel (normaal zijn deze niet in het geel) gehaald worden en in bestand 'totaal' geplaatst worden, waarbij de datum uit de verschillende files vóór de regels geplaatst wordt.

Wie haalt me uit de brand?

 

[AlexCEL]

Is dit een eenmalige actie of komt het vaker voor?

 

[Verwijderd lid 501906]

@Angela69
Wat maakt dat de rijen geel worden?
Is dat een waarde in kolom R?

 

[Verwijderd lid 501906]

Ik zie op blad 2 een paar gele vlakken aan het begin
daarom heb ik gekeken naar kolom B voor de waarde geel.

Is dit wat je zoekt nog niet helemaal af datum moet nog toegevoegd

 

[Verwijderd lid 501906]

@Angela69

Ik denk dat het zo werkt.
G3 voor de gele cellen in nieuw blad.
Ik heb er geen batch bewerking van kunnen maken.

 

[Verwijderd lid 501906]

In deze versie heb ik rekening gehouden met een eventuele fout in file 1
daar zijn namelijk in kolom A cellen NIET geel en ik denk dat deze cellen wel geel moeten zijn.

Verder kun je meerdere files toewijzen die in een keer gekopieerd worden.
Uit bestand is mij nog niet gelukt.
Hiervoor heb ik meer data nodig over de structuur van de namen in de file staat er een extensie achter?

 

[snb]

Uit de brand ?
Begin het blussen zelf met de verwijdering van alle samengevoegde cellen.

 

[Verwijderd lid 501906]

@snb
aan wie is je reactie gericht?
Als dit aan mij gericht is dan is mijn vervolgvraag 'leg uit'

 

[Angela69]

In deze versie heb ik rekening gehouden met een eventuele fout in file 1
daar zijn namelijk in kolom A cellen NIET geel en ik denk dat deze cellen wel geel moeten zijn.

Verder kun je meerdere files toewijzen die in een keer gekopieerd worden.
Uit bestand is mij nog niet gelukt.
Hiervoor heb ik meer data nodig over de structuur van de namen in de file staat er een extensie achter?

Hoi Ruben,
Ik ben vergeten te melden dat de rijen door mij geel GEMAAKT zijn om aan te geven om welke regels het gaat, maar in werkelijkheid zijn ze "gewoon" wit

 

[Verwijderd lid 501906]

@Angela69
Hmmmm zonde van al het werk.
Definieer eerst eens correct waarop gefilterd moet worden.
Hoe je naam structuur in elkaar zit van de in te lezen bestanden.
Komt dit vaker voor of is het eenmalig.
Zijn dit vaste formulieren.
etc.

PS ik pas verder!

 

[HSV]

@Angela69,
Volg de goede raad van @snb op.

 

[AHulpje]

Je celindeling is inderdaad een ramp, maar probeer het hier eens mee. De te verwerken bestanden moeten in dezelfde map staan waarin te-tellen.xlsm staat.

 

[HSV]

Indien je structuur aanbrengt in je gegevens zoals onder 'Dag'; Het is natuurlijk een drama dat sommige gegevens in samengevoegde cellen A:B staan en de andere gegevens in niet samengevoegde cellen in kolom B (Bestand 1.xslx).

Ps. zet alle bestanden in dezelfde map en c00 aanpassen..
c00 = "C:\Users\Angela69\documents\excelbestanden\"

Code in een standaard module plaatsen in werkboek 'totaal."

Sub hsv()
Dim c00 As String, c01 As String, sv, i As Long, j As Long
ReDim arr(17, 0)
c00 = "C:\Users\Angela69\documents\excelbestanden\"
c01 = Dir(c00 & "*.xlsx")
    Do Until c01 = ""
        With GetObject(c00 & c01).Sheets(1)
         sv = .UsedRange
          For i = 11 To UBound(sv)
            If IsNumeric(sv(i, 1)) And sv(i, 1) <> "" Or IsNumeric(sv(i, 2)) And sv(i, 2) <> "" Then
               arr(0, UBound(arr, 2)) = sv(3, 7)
                  For j = 1 To 17
                    arr(j, UBound(arr, 2)) = sv(i, j)
                  Next j
               ReDim Preserve arr(17, UBound(arr, 2) + 1)
            End If
          Next i
        .Parent.Close 0
      End With
      c01 = Dir
    Loop
 Sheets(1).Cells(10, 1).Resize(UBound(arr, 2), 18) = Application.Transpose(arr)
End Sub

 

[Angela69]

Je celindeling is inderdaad een ramp, maar probeer het hier eens mee. De te verwerken bestanden moeten in dezelfde map staan waarin te-tellen.xlsm staat.

Natuurlijk is dit een ramp, maar ik krijg deze bestanden zo aangeleverd, dus kan daar zelf weinig aan veranderen. Ik ga de code van HSV een proberen, mogelijk lost dat dit probleem op

 

[Verwijderd lid 501906]

@Angela69
Dat data vaak raar aangeleverd wordt daar heb ik ook last van
Maar probeer uitgebreider te omschrijven waarop je wilt filteren

Kan dit op een vaste waarde die bijvoorbeeld aangeeft dat werk klaar is.

 

[snb]

simpul toch?

sheet1.cells.unmerge

 

[Angela69]

Indien je structuur aanbrengt in je gegevens zoals onder 'Dag'; Het is natuurlijk een drama dat sommige gegevens in samengevoegde cellen A:B staan en de andere gegevens in niet samengevoegde cellen in kolom B (Bestand 1.xslx).

Ps. zet alle bestanden in dezelfde map en c00 aanpassen..
c00 = "C:\Users\Angela69\documents\excelbestanden\"

Code in een standaard module plaatsen in werkboek 'totaal."

Sub hsv()
Dim c00 As String, c01 As String, sv, i As Long, j As Long
ReDim arr(17, 0)
c00 = "C:\Users\Angela69\documents\excelbestanden\"
c01 = Dir(c00 & "*.xlsx")
    Do Until c01 = ""
        With GetObject(c00 & c01).Sheets(1)
         sv = .UsedRange
          For i = 11 To UBound(sv)
            If IsNumeric(sv(i, 1)) And sv(i, 1) <> "" Or IsNumeric(sv(i, 2)) And sv(i, 2) <> "" Then
               arr(0, UBound(arr, 2)) = sv(3, 7)
                  For j = 1 To 17
                    arr(j, UBound(arr, 2)) = sv(i, j)
                  Next j
               ReDim Preserve arr(17, UBound(arr, 2) + 1)
            End If
          Next i
        .Parent.Close 0
      End With
      c01 = Dir
    Loop
 Sheets(1).Cells(10, 1).Resize(UBound(arr, 2), 18) = Application.Transpose(arr)
End Sub

 

[Angela69]

Hmm......... goed bedoeld natuurlijk, maar het bestand ziet er nu zo uit,bij regel 67 gaat het echter mis

 

[AHulpje]

En welke bronbestanden horen daarbij?

 

[HSV]

Het verbaasd me niet.