Formule kopieren a.d.h.v. uitkomst van ingelezen files

[MatthijsE]

Hallo Knappe koppen,

Ik ben op zoek naar een oplossing voor het volgende:

Code:

Sub filesinlezen()


   On Error GoTo fout
   

'clear alles in de range a en B
[A:B].ClearContents

'Excel files inlezen van opgegeven directory
  c0 = ""
  With CreateObject("scripting.filesystemobject").GetFolder(InputBox("Welke directory zoeken ?", "FileSearch", "D:\Test\XLS"))
    For Each fl In .Files
        If Right(fl.Name, 4) = ".xls" Then c0 = c0 & fl.Name & "|"
    Next
    
    'Cellen A1 + B1 voorzien van titel
    
    Cells(1, 1).Value = "File"
    Cells(1, 2).Value = "Project"
    
    ' geef de waarden weer van de ingelezen directory
     
   
      
          [A2].Resize(UBound(Split(c0, "|"))) = WorksheetFunction.Transpose(Split(c0, "|"))
  End With
   
   'onderstaande draagt zorg dat de formule =DEEL(A2;1;10)wordt geplaatst op cel B2
    
      
     Range("B2").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-1],1,10)"
    
    
    
    
    
fout:
    
  
End Sub

Bovenstaande code leest in de opgegeven directory de .xls files in en toont de uitkomst in kolom A. Het onderstuk van de code doet een formule plaatsen op B2 waarbij het projectnummer uit het bestandnaam word geprojecteerd.

Ik ben opzoek naar code die uitzoekt hoeveel .xls bestanden zijn ingelezen en aan de hand van de uitkomst, de formule in kolom B kopieert.

Wie kan mij helpen.

opmerking: MS Excel 2003, en wellicht kan de code veel doeltreffender zoals die nu is, ik ben een absolute leek op vba gebied.

Bedankt

Matthijs E

 

[Wigi]

Dat aantal heb je al met:

UBound(Split(c0, "|"))

Probeer als leek vooral de codes te begrijpen en te doorgronden, kopiëren van code kan wel werken maar helpt je niet verder op langere termijn. Zoek gerust in de helpfiles, op internet, of hier op het forum.

Succes.

Wigi

 

[MatthijsE]

Opgelost

Bedankt voor het voorzetje Wigi

ik ben uit eindelijk tot het volgende gekomen:

Sub filesinlezen()


   On Error GoTo fout
   

'clear alles in de range a en B
[A:B].ClearContents

'Excel files inlezen van opgegeven directory
  c0 = ""
  With CreateObject("scripting.filesystemobject").GetFolder(InputBox("Welke directory zoeken ?", "FileSearch", "D:\Test\XLS"))
    For Each fl In .Files
        If Right(fl.Name, 4) = ".xls" Then c0 = c0 & fl.Name & "|"
    Next
    
    'Cellen A1 + B1 voorzien van titel
    
    Cells(1, 1).Value = "File"
    Cells(1, 2).Value = "Project"
    
    ' geef de waarden weer van de ingelezen directory
     
   
      
          [A2].Resize(UBound(Split(c0, "|"))) = WorksheetFunction.Transpose(Split(c0, "|"))
          [B][B2].Resize(UBound(Split(c0, "|"))) = "=MID(RC[-1],1,10)"[/B]  End With
   
 
       
    
    
fout:
    
  
End Sub

 

[snb]

Sub filesinlezen()
  [A:B].ClearContents

  With CreateObject("scripting.filesystemobject").GetFolder("D:\Test\XLS")
    For Each fl In .Files
      If Right(fl.Name, 4) = ".xls" Then c0 = c0 & fl.Name & "|"
    Next
  End with
  Range("A1:B1") = split("FileProject")
    
  With [A2].Resize(UBound(Split(c0, "|")))
     .Offset(,0) = WorksheetFunction.Transpose(Split(c0, "|"))
     .Offset(,1).formulaR1C1 = "=LEFT(RC[-1],10)"  
  End with
End Sub