Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1440to1444
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Schleife Tabellenblätter öffnen Makro ausführen

Schleife Tabellenblätter öffnen Makro ausführen
07.08.2015 08:31:39
Christoph
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

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife Tabellenblätter öffnen Makro ausführen
07.08.2015 08:49:40
Sepp
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

AW: Schleife Tabellenblätter öffnen Makro ausführen
07.08.2015 09:01:14
Christoph
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

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

AW: Schleife Tabellenblätter öffnen Makro ausführen
07.08.2015 09:58:01
Sepp
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

Anzeige
AW: Schleife Tabellenblätter öffnen Makro ausführen
07.08.2015 17:01:21
Christoph
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

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

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

AW: Schleife Tabellenblätter öffnen Makro ausführen
09.08.2015 03:58:10
Christoph
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

Anzeige
AW: Schleife Tabellenblätter öffnen Makro ausführen
09.08.2015 08:15:45
Sepp
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

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

AW: Schleife Tabellenblätter öffnen Makro ausführen
09.08.2015 13:29:40
Sepp
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

AW: Schleife Tabellenblätter öffnen Makro ausführen
09.08.2015 13:49:46
Christoph
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

Anzeige
AW: Schleife Tabellenblätter öffnen Makro ausführen
09.08.2015 13:59:31
Sepp
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

Anzeige
AW: Schleife Tabellenblätter öffnen Makro ausführen
09.08.2015 14:13:11
Christoph
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

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

AW: Schleife Tabellenblätter öffnen Makro ausführen
09.08.2015 14:28:40
Sepp
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

Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige