Office: Makro Datenimport - Duplikate löschen - sortieren

Hallo,

ich brauche noch einmal Eure Hilfe.

Problem (welches hoffentlich keins ist):

Ich habe eine Excel-Datei, welche wie folgt aufgebaut ist:
Auswertung (x Tabellenblätter),
Datenbereich (31 Blätter für 31 Tage, Bezeichnung „daten1“ bis „daten31“),
Berechnungen (31 Blätter entsprechend dem Datenbereich, Bezeichnung „ausw1“ bis „ausw31“).

Die Exceldatei soll mehrere Monate laufen und die Daten aus Textdateien importieren, Duplikate löschen, das Ganze sortieren und natürlich auswerten.
Mit Eurer Hilfe und dem Aufzeichnen von Makros habe ich mir jetzt pro Tabellenblatt ("datenx") einen Button gebastelt, der den Import, die Löschung von Duplikaten und die Sortierung vornimmt.

Die Wahnsinnslösung wäre ein Makro (Start auf erster Seite der Auswertung), welches die datenblätter „daten1“ bis „daten31“ komplett mit Daten vollpackt, Duplikate entfernt (pro Datenblatt) und das Ganze pro Datenblatt sortiert.
Sollten einmal an einem Tag Daten fehlen, dann sollte der Rest trotzdem importiert werden ohne Abbruch – das wäre schön.
Bzw. soll auch der Datenimport im Falle einer Zwischenabfrage funktionieren (BSp. ich möchte eine Auswertung am 15ten des laufenden Monats. Da können natürlich nur die Daten bis zum 15ten importiert werden).

Ach ja, ich habe über die Funktion „verketten“ dafür gesorgt, dass auf den Datenblättern in A1 jeweils der Pfad für die Textdatei steht. Hierfür trägt der Nutzer einfach das Verzeichnis und den Monat auf der ersten Seite der Auswertung ein.

Ich gebe zu, ich habe keine Ahnung von VBA. Das nachfolgende Makro wirkt daher sicherlich arg zusammenkopiert *g*

Danke für die Hilfe

dusk79


PS: Derzeit besteht jeder Datensatz aus 24 Werten (bis Spalte X). Das wird sich aber noch nach oben ändern. Die Sortierung läuft nach Spalte C, wird sich aber möglicherweise auch noch verschieben. Ich denke, das kriege ich dann vielleicht allein hin. Die Zeilenanzahl variiert auch sehr stark.



Sub Makro1()
'
' Makro1 Makro
'

'
Dim Datei$, DateiName$, AbfrageName$
Datei$ = Range("A1")
DateiName$ = Mid(Datei$, InStrRev(Datei$, "\") + 1)
AbfrageName$ = Left$(DateiName$, InStr(DateiName$, ".") - 1)

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Datei$, _
Destination:=Range("$A$1"))
.Name = AbfrageName$
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 28592
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Range("D5").Select
ActiveWindow.SmallScroll Down:=-15
Columns("A:X").Select
ActiveSheet.Range("A:X").RemoveDuplicates Columns:=Array(1, 2, 3, 6, 7, _
8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24), Header:=xlNo
ActiveWindow.SmallScroll ToRight:=-10
Range("A1").Select

Columns("A:X").Select
ActiveWorkbook.Worksheets("daten1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("daten1").Sort.SortFields.Add Key:=Range( _
"C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("daten1").Sort
.SetRange Range("A:X")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub

 

Hallo,

ich habe Dein Makro "Makro1" geringfügig modifiziert und in "Import_DatenX_Blatt" umbenannt; es macht kurz Folgendes:
1) Im aktiven Arbeitsblatt holt es aus Zelle A1 den Pfad+Dateinamen der Textdatei
2) Diese wird überprüft, ob sie auf der Platte existiert; falls nicht, wird das Makro beendet.
3) Die Textdatei wird dann ab Zelle A1 ins Arbeitsblatt eingelesen (der Pfad+Dateiname wird dadurch überschrieben!!)
4) Zeilen, die Duplikate enthalten, werden entfernt.
5) Die Zeilen werden nach Spalte C sortiert (Die Blattkonstante "daten1" habe ich entfernt und durch ActiveSheet ersetzt)

Code:

Public Sub Import_DatenX_Blatt()

  Dim Datei$, DateiName$, AbfrageName$
  
  Datei$ = Range("A1").Value
  'Falls die DATEI, die in Zelle A1 angegeben wurde, nicht existiert,
  'beende dieses Makro:
  If Dir(Datei$) = "" Then Exit Sub
  
  DateiName$ = Mid(Datei$, InStrRev(Datei$, "\") + 1)
  AbfrageName$ = Left$(DateiName$, InStr(DateiName$, ".") - 1)
  
  With ActiveSheet
  
      With .QueryTables.Add(Connection:="TEXT;" & Datei$, Destination:=Range("$A$1"))
        .Name = AbfrageName$
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 28592
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
      End With '.QueryTables.Add
      
      .Range("A:X").RemoveDuplicates Columns:=Array(1, 2, 3, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24), Header:=xlNo
          
      With .Sort
        With .SortFields
          .Clear
          .Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .SetRange Range("A:X")
        .Header = xlGuess       '<-- xlNo ??
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
      End With '.Sort
      
  End With 'ActiveSheet
  
End Sub

Ich habe ein 2. Makro geschrieben ("Import_DatenX_AlleBlätter"), welches das 1. Makro voraussetzt. Es macht Folgendes:
1) Es überprüft sämtliche Arbeitsblätter der aktive Arbeitsmappe, ob ihr Name mit "Daten" oder "daten" beginnt
2) Falls ja, wird das betreffende Blatt zum aktiven Blatt gemacht und das 1. Makro ausgeführt.

Code:

Public Sub Import_DatenX_AlleBlätter()
  Dim Ws As Worksheet
  For Each Ws In ActiveWorkbook.Worksheets
    If Ws.Name Like "[Dd]aten*" Then
      Ws.Activate
      Call Import_DatenX_Blatt
    End If
  Next Ws
End Sub

Dieses 2. Makro kann ebenfalls mit einem Button aufgerufen werden.

 

Hallo Exl121150,

vielen Dank für die schnelle Hilfe.

Deine Makros machen mit meinen Daten (nahezu) das, was sie sollen. Und das ist fantastisch.

Einziges Problem ist noch die Löschung der Duplikate.
Das Makro sollte alle identischen Zeilen löschen (ausgenommen die Spalten 4 und 5 - das ist das Datum und die Uhrzeit der Aufzeichnung).
Nach Anwendung des Makros sind allerdings alle doppelten Zeilen gelöscht, die sich allein in den Spalten 1-3 gleichen. Damit sind alle Messwerte weg ;) - nur der erste aufgezeichnete Wert steht noch da.
Ich kann mir nicht erklären, worin der Unterschied zwischen Deinem Makro und meinem aufgezeichneten liegt.

Wäre schön, wenn Du mir noch einmal helfen könntest.

Viele Grüße

dusk79

 

Hallo,

im vorgenannten Codefragment ist die RemoveDuplicate-Methode des Range-Objektes enthalten. Diese Methode ist zuständig für das Filtern doppelter Datensätze.
Sie wird in diesem Fall auf den Bereich der Spalten A-X (also Spalten-Nr. 1-24) angewendet. Sie besitzt 2 benannte Argumente:

Argument Columns: besteht in einer Auflistung aller Spaltennummern des Bereiches (in diesem Fall des Bereiches A:X), die für den Test auf doppelte Zeilenwerte herangezogen werden. Nur solche Zeilen werden entfernt, die in allen diesen Spalten gleichzeitig gleiche Einträge besitzen; treten solche Zeilen auf, wird jeweils nur die 1. dieser Zeilen übernommen, während die restlichen dieser (in der Spaltenliste) identischen Zeilen ignoriert (=entfernt) werden bei Ausführung dieser Methode.
Wie Du siehst, sind in vorgenannter Array-Liste die Spalten 4 und 5 nicht enthalten. Diese beiden Spalten werden nicht für den Test auf Zeilengleichheit herangezogen, während die Spalten A:C und F:X auf Gleichheit getestet werden.
Ich habe diese Einstellungen 1:1 aus Deinem Makro übernommen, da Du ja diesbezüglich im 1. Posting keine genauere Beschreibung gemacht hast.

Argument Header: erhält den Wert 'xlNo' zugewiesen und zeigt damit an, dass der Spaltenbereich A:X in der 1. Zeile (also in A1:X1) keine Spaltenüberschriften enthält.

Also müsste nach Deiner jetzigen Problembeschreibung Deine jetzige Makrozeile lauten:

statt korrekterweise:

Eine weitere Bemerkung, was den Sort-Abschnitt am Ende des Makros betrifft:
Dort hast Du stehen: .Header = xlGuess
Da Du offenbar in A1:X1 keine Überschrift für die Spalten A:X hast, würde ich diese Zeile ersetzen durch:
.Header = xlNo
denn sicher ist sicher - nicht dass die 1. Zeile von der Sortiermethode falsch erraten wird. - Ich weiß, diesen Wert (xlGuess) setzt der Makrorecorder ein (weil es der bequemste Wert ist, falls nichts Explizites eingestellt wurde).

 

Guten Morgen,

was ich jetzt gleich schreibe, ist mir fast schon peinlich *g*

Also: Ich hatte Dein makro kopiert.
Die Auswahl der Spaltennummern (1-3 und 6-24) hatte ich so verstanden, wie Du es beschrieben hast. Und so sollte die Entfernung der Duplikate auch erfolgen.
Nur leider (und ich weiß nicht warum) entfernt mein Excel alle Zeilen, die in den Spalten 1-3 (oder 2 - oder auch nur 3) doppelte Werte ausweisen. Ich kann es nicht eingrenzen - auf jeden Fall sind die Messwerte der Spalten 6-24 unterschiedlich und fliegen alle raus.

Wie schon gesagt - ich habe den Code kopiert. Müsste ich vielleicht bei den Excel-Einstellungen irgendetwas ändern (was ich aber nicht vermute).

(Die Sache mit der Tabellenüberschrift habe ich angepasst - vielen dank. An so was muss man echt denken.)

Viele Grüße

dusk79

 

Hallo noch mal ...

jetzt klappt's. Keine Ahnung welches unzutreffende Makro ich da noch irgendwo drin hatte.
Vielen Dank.

dusk79