"lege" cellen importeren uit diverse bestanden

Status
Niet open voor verdere reacties.
H

hout80

Gebruiker
Lid geworden
17 apr 2007
Berichten
35
Hallo,

M.b.v. onderstaande code importeer ik, uit alle -xls bestanden in een bepaalde map, diverse cellen met gegevens/waarden en deze worden dan netjes in een tabel gezet.
Zolang alle te importeren cellen maar een waarde hebben gaat dit uitstekend. Is een cel echter "leeg" dan schuift de volgende geimportererde waarde van het volgende bestand van diezelfde cel een positie hoger op.
Zie eventueel het voorbeeld wat ik bedoel.

voorbeeld.JPG


De volgende code gebruik ik:

Code: 
Set oud = ActiveWorkbook
directory = "D:\Beurs\vestiging\oldenzaal\"
sfile = Dir(directory & "*.xls")
While sfile <> ""
    Set nieuw = Application.Workbooks.Open(directory & sfile)
    
    oud.ActiveSheet.Range("a65000").End(xlUp).Offset(1, 0) = nieuw.ActiveSheet.Range("b2")
    oud.ActiveSheet.Range("b65000").End(xlUp).Offset(1, 0) = nieuw.ActiveSheet.Range("b3")
    oud.ActiveSheet.Range("c65000").End(xlUp).Offset(1, 0) = nieuw.ActiveSheet.Range("b4")
    oud.ActiveSheet.Range("e65000").End(xlUp).Offset(1, 0) = nieuw.ActiveSheet.Range("b5")
    oud.ActiveSheet.Range("f65000").End(xlUp).Offset(1, 0) = nieuw.ActiveSheet.Range("b6")
    oud.ActiveSheet.Range("g65000").End(xlUp).Offset(1, 0) = nieuw.ActiveSheet.Range("b7")
    oud.ActiveSheet.Range("h65000").End(xlUp).Offset(1, 0) = nieuw.ActiveSheet.Range("o9")
    oud.ActiveSheet.Range("i65000").End(xlUp).Offset(1, 0) = nieuw.ActiveSheet.Range("r10")
    nieuw.Close
    sfile = Dir
Wend

Hoe krijg ik voor elkaar dat een "lege" cel ook wordt geïmporteerd als een "lege" cel ?

Alvast bedankt,

Hugo
 
Uit het vuistje
Code: 
Sub tst()
Application.ScreenUpdating = False
Dim tMatrix() As Variant
ReDim tMatrix(9, 1)
directory = "D:\Beurs\vestiging\oldenzaal\"
sfile = Dir(directory & "*.xls")
While sfile <> ""
    Set nieuw = Application.Workbooks.Open(directory & sfile)
    tMatrix(0, UBound(tMatrix, 2)) = nieuw.ActiveSheet.Range("b2")
    tMatrix(1, UBound(tMatrix, 2)) = nieuw.ActiveSheet.Range("b3")
    tMatrix(2, UBound(tMatrix, 2)) = nieuw.ActiveSheet.Range("b4")
    tMatrix(3, UBound(tMatrix, 2)) = ""
    tMatrix(4, UBound(tMatrix, 2)) = nieuw.ActiveSheet.Range("b5")
    tMatrix(5, UBound(tMatrix, 2)) = nieuw.ActiveSheet.Range("b6")
    tMatrix(6, UBound(tMatrix, 2)) = nieuw.ActiveSheet.Range("b7")
    tMatrix(7, UBound(tMatrix, 2)) = nieuw.ActiveSheet.Range("o9")
    tMatrix(8, UBound(tMatrix, 2)) = nieuw.ActiveSheet.Range("r10")
    nieuw.Close
    sfile = Dir
    ReDim Preserve tMatrix(9, UBound(tMatrix, 2) + 1)
Wend
With ActiveSheet
    .Range("A2").Resize(UBound(tMatrix, 2), 9) = WorksheetFunction.Transpose(tMatrix)
    .Rows(2).Delete xlUp
End With
Application.ScreenUpdating = True
End Sub
Ik raad je echter wel aan om ActiveSheet te wijzigen in de werkelijke bladnaam, dit om verrassingen te voorkomen
 
Bedankt,

Na enig 'ontdekken' hoe alles werkt, werkt alles!

Vr. groeten,

Hugo
 
Moest je er nog vragen over hebben, laat dan maar iets weten. :thumb:
 
@WB
Leuk (warm ?) vuistje,
Kan wat kleiner:

Code: 
sub snb()
   c00="D:\Beurs\vestiging\oldenzaal\"
   c01= Dir(c00 & "*.xls")

   Do until c01=""
     with getobject(c00 & c01)
        thisworkbook.sheets(1).cells(rows.count,1).end(xlup).offset(1).resize(,9)=array(.cells(2,2),.cells(3,2),.cells(4,2),"",.cells(5,2),.cells(6,2),.cells(7,2),.cells(9,15),.cells(10,18))
        .close false
      end with
      c01=dir
   loop
End Sub
 
Hallo WB en SNB,

Met de code van Rudi ben ik verder gaan werken. Er moesten in totaal bijna 40 cellen vanaf een drietal werkbladen geïmporteerd worden. Vanuit een variabel aantal bestanden. Dat is me allemaal gelukt.
Maar de code begrijp ik echter nog niet voldoende. Heb ik het goed als ik het volgende zeg:
Door het herschikken van de tabel(matrix) komen de rijen waarin 'lege' cellen voorkomen onderin de tabel te staan?
Dat viel me in ieder geval op vandaag bij wat uittesten.
Als dat zo is de volgende vraag: is dat ook te voorkomen? Dat dus de matrix dezelfde volgorde heeft wanneer alle , te importeren cellen, wel een waarde zou hebben?

met onderstaande code werk ik nu

Code: 
Private Sub Workbook_Open()

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim tMatrix() As Variant
ReDim tMatrix(36, 1)
directory = "D:\Beurs\vestiging\Oldenzaal\"
sfile = Dir(directory & "*.xls")
While sfile <> ""
    Set nieuw = Application.Workbooks.Open(directory & sfile)
    tMatrix(0, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("b2")
    tMatrix(1, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("b3")
    tMatrix(2, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("b4")
    tMatrix(3, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("l11")
    tMatrix(4, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("b5")
    tMatrix(5, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("b6")
    tMatrix(6, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("b7")
    tMatrix(7, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("o9")
    tMatrix(8, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("r10")
    tMatrix(9, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("b8")
    tMatrix(10, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("b9")
    tMatrix(11, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("o8")
    tMatrix(12, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("b12")
    tMatrix(13, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("b13")
    tMatrix(14, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("b10")
    tMatrix(15, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("b11")
    tMatrix(16, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("o3")
    tMatrix(17, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("o5")
    tMatrix(18, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("o4")
    tMatrix(19, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("o6")
    tMatrix(20, UBound(tMatrix, 2)) = nieuw.Sheets("algemeen").Range("o7")
    tMatrix(21, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("d14")
    tMatrix(22, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("d15")
    tMatrix(23, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("c16")
    tMatrix(24, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("d16")
    tMatrix(25, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("b17")
    tMatrix(26, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("d18")
    tMatrix(27, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("l14")
    tMatrix(28, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("l15")
    tMatrix(29, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("l16")
    tMatrix(30, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("l17")
    tMatrix(31, UBound(tMatrix, 2)) = nieuw.Sheets("kader").Range("l18")
    tMatrix(32, UBound(tMatrix, 2)) = nieuw.Sheets("vertrouwelijk").Range("b11")
    tMatrix(33, UBound(tMatrix, 2)) = nieuw.Sheets("vertrouwelijk").Range("b12")
    tMatrix(34, UBound(tMatrix, 2)) = nieuw.Sheets("vertrouwelijk").Range("b13")
    tMatrix(35, UBound(tMatrix, 2)) = nieuw.Sheets("vertrouwelijk").Range("n11")
    tMatrix(36, UBound(tMatrix, 2)) = ""
    nieuw.Close
    sfile = Dir
    ReDim Preserve tMatrix(36, UBound(tMatrix, 2) + 1)
Wend
With ActiveSheet
    .Range("A2").Resize(UBound(tMatrix, 2), 36) = WorksheetFunction.Transpose(tMatrix)
    .Rows(2).Delete xlUp
End With

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

En eigenlijk ligt hier ten grondslag de vraag:
Als ik met onderstaande code een ListBox vul:

Code: 
Private Sub Userform_Initialize()
ListBox1.Clear
Bestand = Dir("D:\Beurs\vestiging\Oldenzaal\*.xls")
Do While Bestand <> ""
    ListBox1.AddItem Left(Bestand, Len(Bestand) - 4)
    Bestand = Dir
Loop
End Sub

Op basis waarvan wordt de volgorde bepaald waarmee de ListBox wordt gevuld? Is dat op basis van: datum&tijd laatst gewijzigd bestand?
Kan ik dat ook mbv VBA zelf regelen? De ene keer op alfabet, een andere keer op een andere voorwaarde?

Alvast bedankt voor het meedenken met deze 'leek'

Hugo
 
In theorie wordt er niets verplaatst bij het vullen v/d tabel.
Voor elk bestand wordt er een rij gereserveerd en voor elke benodigde celwaarde een kolomvakje op die rij.
Is de cel gevuld wordt het vakje ingevuld, anders blijft dit gewoon leeg. Deze tabel wordt in het werkgeheugen opgebouwd (tMatrix) en als alle bestanden gepasseerd zijn in 1 keer
As Is op je werkblad weggeschreven met behoud van de lege cellen op de respectievelijke plaatsen.
De laatste lege waarde in jouw tabel is dus overbodig aangezien ik deze in mijn code had ingevoerd omdat kolom D niet gebruikt mocht worden volgens jouw voorbeeldcode en je dus een lege kolom moest invoegen in de tabel bij het opbouwen.

Als antwoord op je Listboxvraag, deze wordt gevuld naargelang de volgorde in je Dir.
Wil je een sortering zal je dus eerst alle bestandsnamen moeten inlezen in een matrix (in het werkgeheugen), dan de gewenste sortering uitvoeren alvorens er de LB mee te vullen of je moet deze lijst wegschrijven naar een tijdelijk werkblad, de sortering uitvoeren en dan met deze lijst je LB vullen.
 
Kijk eens aan; dat is een geheel andere vraag.
Gebruik nooit 'additem' om een listbox of combobox met meer dan 1 item te vullen.

Code: 
Private sub userform_Initialize()
   listbox1.list=split(createobject("wscript.shell").exec("cmd /c Dir D:\Beurs\vestiging\Oldenzaal\*.xls /b").stdout.readall,vbcrlf)
end sub
 
Laatst bewerkt:
@Rudi:

Bedankt voor je heldere uitleg. Ik begrijp nu grotendeels hoe de betreffende code werkt. Heel anders dan ik had 'bedacht'.
Die lege kolom in mijn voorbeeld was niet als zodanig bedoeld. Zo belangrijk blijkt maar weer: het juist formuleren van de vraag. En het helder maken voor jullie waar ik mee bezig ben en wat ik wil bereiken.

@snb:

Ik kwam dat wel vaker op het forum tegen de opmerking van jou: Gebruik nooit 'additem' om een listbox of combobox met meer dan 1 item te vullen.
Wat is daarvan de achterliggende gedachte? Deze vraag van mij is bedoeld om te proberen steeds meer van VBA te begrijpen.

Bedankt jullie beiden. Ik kan morgen weer verder met mijn project op het werk. Waarschijnlijk zullen er nog wel meer vragen komen deze week.

Vr. groeten,

Hugo
 
Zoals de titel van de methode al aangeeft: het is slechts bedoeld om 1 item toe te voegen.
VBA kent andere methodes om een hele lijst in 1 keer in te lezen in een combobox of listbox. (.List=array(..))
Het voordeel van de .List methode is bovendien dat je ook een meerdimensionele array in 1 keer kunt laden; dat lukt je met de additem methode nooit.
Het voordeel van de .list methode is, dat je een reeds gevulde combobox/listbox niet eerst hoeft leeg te maken met listbox.clear.

Bovendien is 'additem' een merkbaar trage methode.
Voor meer dan 1 item zul je altijd een lus moeten gebruiken; en die vertraagt VBA ook nog eens onnodig. Als je een lus kunt vermijden doe je daar goed aan.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan