Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Mehrere Dateien in einem Ordern durchsuchen


Betrifft: Mehrere Dateien in einem Ordern durchsuchen von: Michael
Geschrieben am: 22.01.2018 15:54:41

Hallo,

ich bin gerade am Auswerten unserer Fertigung. Wir fertigen immer wieder ähnliche Bauteile und haben zum Überwachen immer ein bestimmte Tabelle. Für jeden Auftrag eine. Alle liegen in einem Ordner. Zum Teil haben die Tabellen mehrere Artikel beinhaltet.

Was ich nun will ist aus diesen Tabellen die Werte A7/A20/A33 usw halt immer 13 dazu (entsprechen den Artikelnummern) sowie die Auftragsnummer (ist pro Auftrag immer gleich und steht in A1) zu dursuchen und dazu den fertigen Preis auszulesen aus S7/S20/S33 usw. Diese will ich in eine neue Datei wiedergeben haben (Also Spalte 1 Auftragsnummer (immer A1), Spalte 2 Artikelnummer (A7,A20,usw.) Spalte 3 ISt-Kosten (S7/S20/..) .

Es kann sein, dass wie oben beschrieben nur eine Artikelnummer besetzt ist sprich nur A7, oder eben zwei oder drei, usw.. In den anderen Zellen steht dann der Inhalt "Kein Wert". Diese soll er nicht weitergeben.

Die Ausgangstabellen haben verschiedene Untertabellen von denen immer nur eine (immer die gleiche Benennung) durchsucht werden soll.

Vielen Dank für eure Hilfe!

  

Betrifft: AW: Mehrere Dateien in einem Ordern durchsuchen von: Sepp
Geschrieben am: 22.01.2018 19:08:32

Hallo Michael,

in ein Modul der Zusammenfassungsdatei.

Ungetestet!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub datenLesen()
Dim strPath As String, strFile As String
Dim objWB As Workbook, objSH As Worksheet, objTarget As Worksheet
Dim lngNext As Long, lngRow As Long

Const cstrSheetName As String = "Tabellenname" 'Tabellenname aus der gelesen wird - ANPASSEN!

On Error GoTo ErrorHandler

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .AskToUpdateLinks = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
End With

Set objTarget = Sheets("Tabelle1") 'Tabelle in die geschrieben wird - ANPASSEN!

objTarget.Range("A2:C" & Rows.Count).ClearContents

lngNext = 2

With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "D:\"
  .Title = "Ordnerauswahl"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    strPath = .SelectedItems(1)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  End If
End With

If Len(strPath) Then
  strFile = Dir(strPath & "*xls*", vbNormal)
  Do While strFile <> ""
    Set objWB = Workbooks.Open(Filename:=strPath & strFile, UpdateLinks:=False)
    For Each objSH In objWB.Worksheets
      If objSH.Name = cstrSheetName Then
        lngRow = 7
        Do While objSH.Cells(lngRow, 1) <> "Kein Wert" And objSH.Cells(lngRow, 1) <> ""
          objTarget.Cells(lngNext, 1) = objSH.Range("A1")
          objTarget.Cells(lngNext, 2) = objSH.Cells(lngRow, 1)
          objTarget.Cells(lngNext, 3) = objSH.Cells(lngRow, 19)
          lngRow = lngRow + 7
          lngNext = lngNext + 1
        Loop
        Exit For
      End If
    Next
    objWB.Close False
    strFile = Dir
  Loop
End If

ErrorHandler:

If Err.Number <> 0 Then
  MsgBox "Fehler in Modul1" & vbLf & vbLf & "Prozedur:" & vbTab & "datenLesen" & vbLf & _
    "Nummer:" & vbTab & Err.Number & vbLf & "Meldung:" & vbTab & Err.Description & vbLf & _
    IIf(Erl, "Zeile:" & vbTab & Erl, ""), vbExclamation, "Fehler!"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .AskToUpdateLinks = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
End With

Set objWB = Nothing
Set objSH = Nothing
Set objTarget = Nothing
End Sub


Gruß Sepp



Beiträge aus dem Excel-Forum zum Thema "Mehrere Dateien in einem Ordern durchsuchen "