76 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo zusammen,

ich bin gerade dran ein Excel-File aufzubauen, was folgendes Können sollte:

- Im Ziel-Excel, welches ich aufbaue gibt es eine Spalte A in der jeweils das Datum steht und in den Spalten B bis E eine Produktkategorie

- Ich bekomme nun täglich automatisiert aus dem Kassensystem eine E-Mail zugestellt, die ein Excel-File enthält, was immer in der gleichen Struktur auch den aktuellen Tag im Namen trägt. In diesem Excel-File werden meistens, aber nicht immer alle, Produktkategorien aufgeführt (Spalte A: Kategorie, Spalte B: Umsatz).

- Ich möchte nun diese Informationen automatisch in das Ziel XLS einlesen. Ich nehme an, dass hierfür eine Art SVERWEIS nötig sein wird.

Könnte mir hier jemand Tipps geben wie ich dies per VBA machen kann? Ich habe gelesen das SVERWEIS nicht auf geschlossene Dateien zugreifen kann, deswegen VBA.

Die Ziel-Tabelle soll so aufgebaut sein (Beispiel):

Tag / Bier / Wein / Wasser / etc.
01.01. / EUR 5 / EUR 7 / EUR 10
02.01. / EUR 6 / EUR 8 / EUR 11
03.01. / EUR 7 / EUR 8 / EUR 12

Die Werte sollten jeweils aus den "Tages-XLS" eingelesen werden. Wie gesagt, es könnte auch eine Kategorie fehlen, weil z.B. kein Umsatz in der Kategorie "Wasser" gemacht wurde.

Vielen Dank und viele Grüsse,

Rene

5 Antworten

0 Punkte
Beantwortet von m-o Profi (14.2k Punkte)
Hallo Rene,

ich würde die Daten aus dem jeweiligen Tagesblatt in die Zieltabelle kopieren. Dazu muss aber das Datum bekannt sein. Wie ist denn der Name der Tagesdateien aufgebaut?

Gruß

M.O.
0 Punkte
Beantwortet von
Hallo M.O.,

das Datum in der Zieltabelle ist in Spalte A eingetragen (es gibt ein Blatt je Monat). Der Name der Quelldateien ist folgendermassen aufgebaut: "V2_Tag_2019-01-24___xxx.xls".

Viele Grüsse,

Rene
0 Punkte
Beantwortet von m-o Profi (14.2k Punkte)
 
Beste Antwort

Hallo Rene,

der folgende Code gehört in ein allgemeines Modul deiner Arbeitsmappe (Zieltabelle):

Sub Import()
Dim Datei As Variant
Dim strNameQuelle As String
Dim arrQuelle As Variant
Dim lngMonat As Long
Dim lngTag As Long
Dim strZieltab As String
Dim i As Long
Dim bExists As Boolean
Dim arrUeberschrift As Variant
Dim u As Long
Dim q As Long
Dim z As Long
Dim lngEinfZeile As Long
Dim lngFehlerzeile As Long
Dim bFehler As Boolean

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
    
'Datei-Öffnen Dialog aufrufen
Datei = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xl*), *.xl*", Title:="EINE Datei zum Öffnen auswählen")

  If Datei = False Then
     'Makro abbrechen wenn Benutzer den Öffnen-Dialog abbricht
     MsgBox "Der Benutzer hat abgebrochen.", vbInformation
     Exit Sub
   End If
        
'ausgewählte Datei öffnen
Workbooks.Open (Datei)

With ActiveWorkbook
  'Namen der zu öffnenden Datei in Variable schreiben
   strNameQuelle = .Name
   '1. Arbeitsblatt in Quelldatei auswählen
   With Worksheets(1)
     'Daten in Array einlesen
     arrQuelle = .Range(.Cells(1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .UsedRange.SpecialCells(xlCellTypeLastCell).Column))
   End With
 
   'Quelldatei ohne Änderungen speichern
   .Close (False)
End With

'Monat und Tag aus Dateinamen ermitteln
'Aufbau: V2_Tag_2019-01-24___xxx.xls
lngMonat = CLng(Mid(strNameQuelle, 13, 2))
lngTag = CLng(Mid(strNameQuelle, 16, 2))

'Zielarbeitsblatt anhand des Monats auswählen - Namen ggf. anpassen
Select Case lngMonat
  Case 1: strZieltab = "Januar"
  Case 2: strZieltab = "Februar"
  Case 3: strZieltab = "März"
  Case 4: strZieltab = "April"
  Case 5: strZieltab = "Mai"
  Case 6: strZieltab = "Juni"
  Case 7: strZieltab = "Juli"
  Case 8: strZieltab = "August"
  Case 9: strZieltab = "September"
  Case 10: strZieltab = "Oktober"
  Case 11: strZieltab = "November"
  Case 12: strZieltab = "Dezember"
End Select

'Zielarbeitsblatt in der Mappe suchen
For i = 1 To ThisWorkbook.Worksheets.Count
  If Worksheets(i).Name = strZieltab Then
     bExists = True
     Exit For
  End If
Next i

'Abbruch und Fehlermeldung, falls Zieltabelle nicht gefunden wurde
If bExists = False Then
  MsgBox "Die Tabelle " & strZieltab & "wurde nicht gefunden! Abbruch", 16, "Fehler!"
  Exit Sub
End If

'zum betreffenden Arbeitsblatt wechseln
With ThisWorkbook.Worksheets(i)
  'Überschriften in Array einlesen
  arrUeberschrift = .Range(.Cells(1, 1), .Cells(1, .UsedRange.SpecialCells(xlCellTypeLastCell).Column))
  'für Einfügezeile das Datum in Spalte A durchsuchen
  'ab Zeile 2 durchlaufen, da in 1. Zeiler überschriften stehen - ggf. anpassen
  For z = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
    'in Spalte A steht das Datum als 01.01. im Datumsformat (TT.MM)
     If Day(.Cells(z, 1)) = lngTag Then
       lngEinfZeile = z                      'Einfügezeile in Variable schreiben
       Exit For                              'Schleife verlassen
     End If
  Next z

  'nun die Daten aus der Quelldatei über einen Vergleich der Überschriften in das Zielblatt einfügen
  'Quelle erst ab Zeile 2 durchlaufen, da in 1. Zeile Überschriften stehen
  For q = 2 To UBound(arrQuelle, 1)
   'Schalter für das Finden auf Falsch setzen
    bExists = False
    'Vergleich der Überschriften
    For u = 1 To UBound(arrUeberschrift, 2)
       If arrQuelle(q, 1) = arrUeberschrift(1, u) Then
         bExists = True                                   'Schalter für Gefunden auf Wahr setzen
         .Cells(lngEinfZeile, u) = arrQuelle(q, 2)        'Daten einfügen
      End If
    Next u
    'Falls nicht gefunden, werden fehlerhafte Daten in ein Tabellenblatt Fehler geschrieben, das ggf. neu angelegt wird
    If bExists = False Then
      'Schalter für Fehler auf wahr setzen
      bFehler = True
      For z = 1 To ThisWorkbook.Worksheets.Count
        If Worksheets(z).Name = "Fehler" Then
           bExists = True
           Exit For
        End If
       Next z
        'falls Blatt nicht existiert, das Blatt anlegen
        If bExists = False Then
         'Neues Blatt wird am Ende eingefügt
          Worksheets.Add After:=Worksheets(Worksheets.Count)
          'Neues Blatt benennen
          ActiveSheet.Name = "Fehler"
          'Überschriften einfügen
          Worksheets("Fehler").Cells(1, 1) = "Name der Quelltabelle"
          Worksheets("Fehler").Cells(1, 2) = "Zeile Nr."
          Worksheets("Fehler").Cells(1, 3) = arrQuelle(1, 1)
          Worksheets("Fehler").Cells(1, 4) = arrQuelle(1, 2)
          'Spaltenbreite automatisch festlegen
          Worksheets("Fehler").Columns("A:D").EntireColumn.AutoFit
        End If
        'Einfügezeile im Fehlerblatt wird ermittelt
        lngFehlerzeile = Worksheets("Fehler").Cells(Rows.Count, 1).End(xlUp).Row + 1
        'Daten in das Fehlerblatt schreiben
        Worksheets("Fehler").Cells(lngFehlerzeile, 1) = strNameQuelle
        Worksheets("Fehler").Cells(lngFehlerzeile, 2) = q
        Worksheets("Fehler").Cells(lngFehlerzeile, 3) = arrQuelle(q, 1)
        Worksheets("Fehler").Cells(lngFehlerzeile, 4) = arrQuelle(q, 2)
    End If
  Next q
End With

'Falls Fehler vorhanden sind, auf das Arbeitsblatt mit den Fehlern wechseln
If bFehler = True Then Worksheets("Fehler").Activate

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub


Ich gehe davon aus, dass in der Zielarbeitsmappe das Datum in Spalte A im Datumsformat 01.01. eingetragen ist. Die Namen der Arbeitsblätter für die einzelnen Monate musst du ggf. anpassen.

Mit dem Ausführen des Makros wirst du aufgefordert die zu importierende Excel-Datei auszuwählen. Alles andere erfolgt über das Makro. Sollte ein Eintrag aus der zu importierenden Tabelle nicht einer Kategorie im Zielarbeitsblatt zugeordnet werden können, so wird dieser Eintrag in ein Fehlerblatt geschrieben (wird ggf. angelegt).

Gruß

M.O.

0 Punkte
Beantwortet von
Hi M.O.,

vielen vielen Dank für deine Hilfe! Funktioniert super.

Viele Grüsse,

Rene
0 Punkte
Beantwortet von m-o Profi (14.2k Punkte)
Hallo Rene,

freut mich, das das Makro so funktioniert, wie du willst. Vielen Dank für die Rückmeldung.

Gruß

M.O.
...