Zeilen zählen in Pfad + Name
#1
Moin zusammen,

ich habe mal wieder eine kleine VBA Herausforderung gefunden, die ich vorher versucht habe per VBS zu lösen, bin da aber auch nicht weit gekommen.
Was ich vorhabe ist folgendes:

1. Button in xlsx -> Input Form für Pfadeingabe
2. Nach klick auf OK -> Auflistung aller Excel Dateien in diesem Pfad: Name der Datei; Anzahl der ausgefüllten Zeilen (minus Überschrift) + eine Zelle für Gesamtsumme aller Zeilen

Ich konnte in der Suche nichts genaues finden.
Hat jmd. von euch evtl. dieses Problem schon einmal gelöst?

Danke euch für Ideen

Cheers,
xlsxvba
Top
#2
ich habe aus einem ehemaligen Makro, was ich mir mal zusammengesucht / -gebaut habe nun das hier geschrieben:

Code:
Option Explicit

  Public x() 'für Datei Attribute(?)
  Public I As Long
  Public FSO, oFolder, Fil
  Public objShell, objFolder, objFolderItem
 
Sub MainExtractData()

  Dim NewSheet As Worksheet
  Dim MainFolderName As String

On Error GoTo ErrorHandler

ReDim x(1 To 65536, 1 To 11)
Set objShell = CreateObject("Shell.Application")
Application.ScreenUpdating = False

MainFolderName = InputBox("Please enter the path, where the Excel files are stored! (\\...\etc.): ")
If StrPtr(MainFolderName) = 0 Then Exit Sub 'wenn hier auf Abbrechen geklickt wird, erscheint kein Fehler

Set NewSheet = ThisWorkbook.Sheets.Add
'x(1, 1) = "Path"
x(1, 1) = "File Name"
x(1, 2) = "Number of Rows"
x(1, 3) = "Total Rows:"
'x(1, 4) = 'Summe aller gezählten Zeilen' --> wie hier am besten lösen?

I = 1

Set FSO = CreateObject("scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(MainFolderName)

On Error Resume Next

For Each Fil In oFolder.Files
  Set objFolder = objShell.Namespace(oFolder.Path)
  Set objFolderItem = objFolder.ParseName(Fil.Name)
 
  I = I + 1
 
  'x(I, 1) = oFolder.Path
  x(I, 1) = Fil.Name
  'x(I, 2) = Count Number of Rows
 
Next


With Range("A1").Resize(I, 11) 'hier A1 anpassen, wenn in anderer Zelle Input starten soll
  .Value = x
  .WrapText = False
  .EntireColumn.AutoFit
  .Rows(1).Font.Bold = True
  .Rows(2).Select
  ActiveWindow.FreezePanes = True
  .Range("A1").Activate
End With

Set FSO = Nothing
Set objShell = Nothing
Set oFolder = Nothing
Set objFolder = Nothing
Set objFolderItem = Nothing
Set Fil = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
Exit Sub



ErrorHandler:

  If Err = 76 Then 'Error 76 wird hier abgefangen, wenn Pfadangabe inkorrekt
  MsgBox "Bitte einen korrekten Pfad angeben" '& Err.Description & Err.Number
  End If
  If Err <> 0 And Err <> 76 Then 'für alle anderen Fehler außer Fehler 76
  MsgBox "Unerwarter Fehler"
  End If

End Sub

Es fehlt allerdings noch eine Funktion, um die Zeilen - 1 in den jeweiligen Excel Dateien zu zählen und eine Funktion, die mir die Summe aller gezählten Zeilen in die Zelle D1 schreibt.
Könnt ihr mir sagen, wie ich das ergänzen kann?

Besten Dank & VG!!
Top
#3
Zur Frage mit der Summe sollte doch an sich das hier gehen:

Code:
x(1, 4) = Range("D1").Formula = "=Sum(B2:B10000)"


... gibt mir aber nur ein "FALSCH" zurück.


Wäre euch sehr dankbar für 1-2 Tipps :)
Top
#4
Hallöchen,

mit Deinem Code erhälst Du das Ergebnis eines Vergleichs. WAHR würde kommen, wenn die Formel in D1 der programmierten entspricht.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste