Schleife Tabellenblätter öffnen Makro ausführen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 07.08.2015 08:31:39

Hallo
ich habe folgendes Problem.
Ich würde gerne eine Schleife haben wollen die mehrere Tabellenblätter öffnet und nach bestimmten Werten sucht und diese in eine andere Datei einfügt.
Mein Code sieht im Moment so aus:

Sub EANFinden
        Windows("TabelleX.xlsx").Activate
        Columns("A:A").Select
        Selection.Find(What:="Ebay-Artikelnummer", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Select
        ActiveCell.Offset(1, 0).Select
        Selection.Copy
        Windows("Artikelnummern zuordnen.xlsx").Activate
        Sheets("Tabelle1").Select
        Range("A2").Select
        ActiveSheet.Paste
        Selection.NumberFormat = "0"
        Windows("TabelleX.xlsx").Activate
        Sheets("Tabelle0").Select
        Columns("A:A").Select
        Selection.Find(What:="978", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Select
        Selection.Copy
        Windows("Artikelnummern zuordnen.xlsx").Activate
    Sheets("Tabelle1").Select
        Range("B2").Select
    ActiveSheet.Paste
    Selection.NumberFormat = "0"
End Sub
TabelleX ist die Tabelle wo die Werte gefunden werden sollen.
Die Tabellen sind Alle fortlaufend nummeriert mit den Namen "Tabelle0", "Tabelle1" usw.
Ziel des Makros soll es sein das es sich allein alle Tabellen aufmacht, mein Makro durchlaufen lässt und anschließend die Tabelle schließt und die nächste öffnet.
Bei meinem Makro ist noch das Problem das er ja nach jeden Durchlauf sowohl in Spalte A als auch in Spalte B immer eine Zeile tiefer gehen muss und nicht in Zeile 2 bleibt.
Ich hoffe man versteht wie ich es meine und kann mir vielleicht helfen.
Gruß
Christoph

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Sepp
Geschrieben am: 07.08.2015 08:49:40
Hallo Christoph,
um Werte aus anderen Dateien auszulesen, muss man die Dateien nicht unbedingt öffnen.
Wie sieht den so eine Datei aus? (Beispieldatei?)
Auf welchem Tabellenblatt stehen die Werte?
Was genau soll ausgelesen werden?

Gruß Sepp


Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 07.08.2015 09:01:14
Ist eine CSV-Datei
Ausgelesen werden soll immer die Artikelnummer.
die befindet sich immer eine Zeile unter "Ebay-Artikelnummer" deshalb lass ich danach suchen und kopiere eine Zeile dadrunter.
Außerdem soll die EAN-Nummer ausgelesen werden.
Tabellenblattname entspricht der Datei.
Hoffe das beantwortet erstmal deine Fragen.
https://www.herber.de/bbs/user/99385.txt
Wie gesagt ist ne csv-Datei.
Kann ich hier blos nicht hochladen
Gruß Christoph

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Sepp
Geschrieben am: 07.08.2015 09:32:30
Hallo Christoph,
probier mal.
https://www.herber.de/bbs/user/99386.xlsm

Gruß Sepp


Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 07.08.2015 09:54:10
Hallo
Ich weiß zwar nicht wie das funktioniert.
Aber ich bin begeistert.
Ich Danke dir mal wieder!
Gruß
Christoph

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Sepp
Geschrieben am: 07.08.2015 09:58:01
Hallo Christoph,
ist gar nicht so schwer. Aus den CSV's wird der gesamte Text in die Variable "strTmp" eingelesen und anschließend in das Array "vntText", per Split() an den Zeilenumbrüchen getrennt, eingelesen.
Das Array wird dann nach den Suchbegriffen "eBay-Artikelnummer" bzw. "EAN" durchsucht und die Werte in die Tabelle geschrieben.

Gruß Sepp


Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 07.08.2015 17:01:21
Hallo
Habe nochmal eine Frage.
Ist vielleicht einer Erweiterung des Makros möglich das das Makro nach 978 sucht und dann diese 13 stellige Zahl reinkopiert?
Grund ist das manche Dateien ean zu stehen haben aber dort kein Nummer dahinter steht.
Außerdem wäre es gut wenn in Spalte A der Dateinamen kommt in Spalte B Artikelnummer und Spalte C EAN.
Dadurch lässt sich dann leichter sehen wenn in einer Tabelle nichts von beiden vorhanden ist. Bzw wenn ein Fehler bei einer Nummer ist in welche Tabelle dieser ist.
Gruß Christoph

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Sepp
Geschrieben am: 07.08.2015 17:18:35
Hallo Christoph,
hoffe, dich richtig verstanden zu haben.
https://www.herber.de/bbs/user/99411.xlsm

Gruß Sepp


Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 07.08.2015 17:56:05
Hi Sepp,
ja wie immer passiert genau das was ich wollte.=)
Ich danke dir mal wieder.
Gruß Christoph

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 09.08.2015 03:58:10
Hallo
https://www.herber.de/bbs/user/99430.txt
Habe jetzt leider bei manchen csv Dateien das Problem das die ISBN in einem anderen Format steht.
Beispiel:
ISBN: 978-3-14-150516-0,
https://www.herber.de/bbs/user/99430.txt
Diese werden nicht kopiert.
ElseIf LCase(vntText(lngI)) Like "*isbn,*" Then
.Cells(lngRow, 6) = Split(vntText(lngI), ",")(1)
lngEntry = 1
End If
Wie muss ich diesen Codeschnippsel ändern das er mir diese kopiert?
Am besten wäre ohne "-".
Gruß Christoph

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Sepp
Geschrieben am: 09.08.2015 08:15:45
Hallo Christoph,
probier mal.

ElseIf LCase(vntText(lngI)) Like "*isbn*" Then
  If LCase(vntText(lngI)) Like "*isbn:*" Then
    .Cells(lngRow, 4) = Val(Replace(Split(vntText(lngI), ":")(1), "-", ""))
  Else
    .Cells(lngRow, 4) = Split(vntText(lngI), ",")(1)
  End If
  lngEntry = 1
End If

Gruß Sepp


Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 09.08.2015 13:11:19
Hallo Sepp
leider klappt das nicht.
Werden nicht gefunden.
habe isbn auch nochmal zu 978 geändert. Wird aber trotzdem nichts gefunden.
Gruß Christoph

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Sepp
Geschrieben am: 09.08.2015 13:29:40
Hallo Christoph,
also bei mir, werden aus allen deinen hochgeladenen Dateien, die korrekten Werte ausgelesen.
Das kommt davon, wenn die Beispieldateien nicht mit den Originalen übereinstimmen!

Gruß Sepp


Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 09.08.2015 13:49:46
HAllo Sepp,
gleiche Datei befindet sich in meinem Ordner zum auslesen von den Werten.
Habe jetzt nochmal deine Datei hochgeladen mit den Sachen die ich geändert habe.
In der letzten Zeile befindet sich die Datei aus der die ean mit deinen vorgegeben Code nicht ausgelesen wird.
https://www.herber.de/bbs/user/99434.xlsm
Gruß
Christoph

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Sepp
Geschrieben am: 09.08.2015 13:59:31
Hallo Christoph,
leider habe ich auf deine Desktop keinen Zugriff, deshalb kann ich die Datei nicht testen.
Du kannst nicht zwei mal die selbe ElseIf- Abfrage machen, da wird immer nur die erste ausgewertet!

If Len(strPath) Then
  With ThisWorkbook.Sheets("Tabelle1")
    .Range("A2:H" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)).Clear
    .Range("A:H").NumberFormat = "0"
    strFile = Dir(strPath & "*.csv", vbNormal)
    Do While strFile <> ""
      strTmp = ReadFile(strPath & strFile)
      vntText = Split(strTmp, vbCrLf)
      For lngI = 0 To UBound(vntText)
        If LCase(vntText(lngI)) Like "*ebay-artikelnummer:*" Then
          .Hyperlinks.Add Anchor:=.Cells(lngRow, 1), Address:=strPath & "\" & strFile
          .Cells(lngRow, 2) = Val(Trim(vntText(lngI + 1)))
          lngEntry = 1
        ElseIf LCase(vntText(lngI)) Like "ean*" Then
          .Cells(lngRow, 3) = Split(vntText(lngI), ",")(1)
          lngEntry = 1
        ElseIf LCase(vntText(lngI)) Like "*978*" Then
          .Cells(lngRow, 4) = Split(vntText(lngI), ",")(1)
          lngEntry = 1
        ElseIf LCase(vntText(lngI)) Like "*isbn*" Then
          If LCase(vntText(lngI)) Like "*isbn:*" Then
            .Cells(lngRow, 5) = Val(Replace(Split(vntText(lngI), ":")(1), "-", ""))
          Else
            .Cells(lngRow, 6) = Split(vntText(lngI), ",")(1)
          End If
          lngEntry = 1
        End If
      Next
      lngRow = lngRow + lngEntry
      lngEntry = 0
      strFile = Dir
    Loop
  End With
End If

Gruß Sepp


Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 09.08.2015 14:13:11
Hallo Sepp,
Das ist die Datei aus Zeile 45
https://www.herber.de/bbs/user/99435.txt
In Zeile 125 befindet sich die Isbn Nummer.
Das ist die Datei aus Zeile 56
https://www.herber.de/bbs/user/99436.txt
In Zeile 150 befindet sich die Isbn Nummer.
Das ist die Datei aus Zeile 227
https://www.herber.de/bbs/user/99437.txt
In Zeile 127 befindet sich die Isbn.
Die Ausleseungstabelle.
https://www.herber.de/bbs/user/99438.xlsm

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Christoph Zahn
Geschrieben am: 09.08.2015 14:14:28
Nachtrag
Kann es dadran liegen das zwischen der isbn: und der Zahl ein Leerzeichen ist?

Bild

Betrifft: AW: Schleife Tabellenblätter öffnen Makro ausführen
von: Sepp
Geschrieben am: 09.08.2015 14:28:40
Hallo Christoph,
bei so vielen unterschiedlichen Möglichkeiten, wird es immer Ausreißer geben, außer man kennt alle möglichen Kombinationen der verschiedenen Werte.

Sub ImportFromCSV()
Dim strPath As String, strFile As String, strTmp As String
Dim vntText As Variant
Dim lngI As Long, lngN As Long, lngRow As Long, lngEntry As Long

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlManual
  .DisplayAlerts = False
End With

lngRow = 2

With Application.FileDialog(msoFileDialogFolderPicker)
  .InitialFileName = "E:\Forum" 'Startverzeichnis - Anpassen!
  .Title = "CSV-Import Ordnerauswahl"
  .ButtonName = "Import Starten"
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then
    strPath = .SelectedItems(1)
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  End If
End With

If Len(strPath) Then
  With ThisWorkbook.Sheets("Tabelle1")
    .Range("A2:H" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)).Clear
    .Range("A:H").NumberFormat = "0"
    strFile = Dir(strPath & "*.csv", vbNormal)
    Do While strFile <> ""
      strTmp = ReadFile(strPath & strFile)
      
      vntText = Split(strTmp, vbCrLf)
      For lngI = 0 To UBound(vntText)
        If LCase(vntText(lngI)) Like "*ebay-artikelnummer:*" Then
          .Hyperlinks.Add Anchor:=.Cells(lngRow, 1), Address:=strPath & "\" & strFile
          .Cells(lngRow, 2) = Val(Trim(vntText(lngI + 1)))
          lngEntry = 1
          For lngN = lngI + 2 To UBound(vntText)
            If LCase(vntText(lngN)) Like "ean*" Then
              .Cells(lngRow, 3) = Split(vntText(lngN), ",")(1)
              lngEntry = 1
            ElseIf LCase(vntText(lngN)) Like "*isbn*" Then
              If LCase(vntText(lngN)) Like "*isbn:*" Then
                .Cells(lngRow, 5) = Val(Replace(Split(vntText(lngN), ":")(1), "-", ""))
              Else
                .Cells(lngRow, 6) = Split(vntText(lngN), ",")(1)
              End If
              lngEntry = 1
            ElseIf LCase(vntText(lngN)) Like "*978*" Then
              .Cells(lngRow, 4) = Split(vntText(lngN), ",")(1)
              lngEntry = 1
            End If
          Next
          Exit For
        End If
      Next
      lngRow = lngRow + lngEntry
      lngEntry = 0
      strFile = Dir
    Loop
  End With
End If

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'ImportFromCSV'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - ImportFromCSV"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlAutomatic
  .DisplayAlerts = True
  .StatusBar = False
End With
End Sub


Gruß Sepp


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Schleife Tabellenblätter öffnen Makro ausführen"