Mehrere Dateien in einem Ordern durchsuchen

Forumthread: Mehrere Dateien in einem Ordern durchsuchen

22.01.2018 15:54:41

Michael

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!

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Mehrere Dateien in einem Ordern durchsuchen

22.01.2018 19:08:32

Sepp

AW: Mehrere Dateien in einem Ordern durchsuchen

22.01.2018 19:08:32

Sepp

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

Beliebteste Forumthreads (12 Monate)

Mehrere Dateien in einem Ordern durchsuchen

Forumthread: Mehrere Dateien in einem Ordern durchsuchen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread