Makro gesucht

Bild

Betrifft: Makro gesucht
von: Tania K
Geschrieben am: 10.08.2015 10:00:25

Hallo liebes Forum,
ich habe schon länger ein Problem und bekomme es einfach nicht gelöst. Ich hatte jetzt schon mal eine Funktion gefunden, die alles ausführt, jedoch ist es eine Matrix-Funktion und viiiel zu langsam, da es zu viele Datensätze sind.
Deshalb brauche ich eure Hilfe:
Ich habe eine Datei, die sich wiederum die Daten aus einer anderen Datei in einer Aktualisierungsabfrage zieht. Ergebnis sind dann 3 Tabellenblätter die gleich aufgebaut sind mit Bestellnr, KW, Lieferant und Preis.
Ich möchte jetzt in ein neues Tabellenblatt alle Bestellnummern automatisch hineinkopiert haben. Schwierigkeit dabei ist dass sich die 3 Tabellenblätter beim Öffnen der Datei wieder aktualisieren - heißt: es kommen neue hinzu und teilweise werden aber auch Bestellnummern wieder heraus gelöscht. Ich möchte jetzt, dass in meiner neuen Tabelle nur noch nicht vorhandene Bestellnummern hinzu gefügt werden. Und das am besten dann, wenn in das neue Tabellenblatt geklickt wird.
Ich habe zur Verdeutlichung eine Datei hochgeladen, die aber viel weniger Daten beinhaltet als Original.
https://www.herber.de/bbs/user/99457.xlsx
Hoffe das war nicht zu kompliziert erklärt.
Herzlichen Dank schon mal für eure Hilfe
Tania

Bild

Betrifft: AW: Makro gesucht
von: Rudi Maintaire
Geschrieben am: 10.08.2015 11:28:32
Hallo,
in ein Modul:

Sub BestNr()
  Dim i As Integer, arr, oBNr, wks As Worksheet
  Set oBNr = CreateObject("Scripting.dictionary")
  For Each wks In Worksheets
    If Not wks Is Sheets(1) Then
      With wks
        arr = .Cells(1, 1).CurrentRegion
        For i = 2 To UBound(arr)
          If WorksheetFunction.CountIf(Sheets(1).Columns(1), arr(i, 1)) = 0 Then
            oBNr(arr(i, 1)) = 0
          End If
        Next i
      End With
    End If
  Next wks
  If oBNr.Count Then
    With Sheets(1)
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(oBNr.Count) _
        = WorksheetFunction.Transpose(oBNr.keys)
    End With
  End If
End Sub

In Tabelle1:
Private Sub Worksheet_Activate()
  BestNr
End Sub

Gruß
Rudi

Bild

Betrifft: AW: Makro gesucht
von: Tania K
Geschrieben am: 10.08.2015 12:09:00
Super lieben Dank! Das funktioniert prächtig. Ich habe nur noch eine Frage dazu. Sollten noch mehr Tabellenblätter mit anderen Auswertungen in der Datei enthalten sein, kann ich dann das Makro so verändern:
If Not wks Is Sheets(1, 4, 5) Then
?
Danke für die schnelle Hilfe
Tania

Bild

Betrifft: AW: Makro gesucht
von: Rudi Maintaire
Geschrieben am: 10.08.2015 12:22:36
Hallo,
dann besser

Sub BestNr()
  Dim i As Integer, arr, oBNr, wks As Worksheet
  Set oBNr = CreateObject("Scripting.dictionary")
  For Each wks In Sheets(Array("Projekt-Bestellung", "Lager-Bestellung", "Funktion-Bestellung")) _
    With wks
      arr = .Cells(1, 1).CurrentRegion
      For i = 2 To UBound(arr)
        If WorksheetFunction.CountIf(Sheets(1).Columns(1), arr(i, 1)) = 0 Then
          oBNr(arr(i, 1)) = 0
        End If
      Next i
    End With
  Next wks
  If oBNr.Count Then
    With Sheets(1)
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(oBNr.Count) _
        = WorksheetFunction.Transpose(oBNr.keys)
    End With
  End If
End Sub
Gruß
Rudi

Bild

Betrifft: AW: Makro gesucht
von: Tania K
Geschrieben am: 10.08.2015 12:26:47
Prima, Danke!

Bild

Betrifft: Lösung ohne Makro
von: Jürgen V.
Geschrieben am: 10.08.2015 11:48:13
Hallo Tania,
da Du Dich mit Datenimporten und Aktualisierungsabfragen auskennst, noch ein Tipp: wenn die Quelldateien der bisherigen Datenimporte in einem gemeinsamen Verzeichnis liegen, vom gleichen Datentyp sind und der Import über MS Query erfolgt, kannst Du ein viertes Arbeitsblatt anlegen, in das Du erneut einen Import für die erste Datei anlegst und anschließend über dessen Eigenschaften den dahinter liegenden SQL-Code anpasst, d.h. über "Union All" die zweite und dritte Datenquelle hinzufügst.
Alternativ kannst Du auch auf dem vierten Blatt einen Datenimport (per MS Query) einrichten, der sich auf die drei bereits vorhandenen Import-Blätter der gleichen Excel-Datei bezieht (z. B. wieder ein Blatt als Datenquelle einbinden und den SQL-Code mit "Union All"-Statements erweitern). Dabei gibt es zwar ab und an eine Fehlermeldung, im Ergebnis funktioniert das aber recht gut und ist deutlich performanter als z. B. SVerweis-Lösungen oder die meisten Makro-Lösungen.
Gruß, Jürgen

Bild

Betrifft: AW: Lösung ohne Makro
von: Tania K
Geschrieben am: 10.08.2015 12:16:43
Hi Jürgen,
mit der UnionAll Funktion habe ich schon herum probiert. Aber ich habe es nie hinbekommen, da manuell zu den Bestellnummern etwas eingetragen wird, und sobald dann eine Bestellnr gelöscht wurde, war alles verschoben. Aber vielleicht habe ich ja auch etwas falsch gemacht dabei.
Aber Dank dir für den Tipp!

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Wenn Formel"