Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Suchen und kopieren mit variabler Liste

Betrifft: Suchen und kopieren mit variabler Liste von: Pochi
Geschrieben am: 01.08.2014 11:53:22

Hallo Leute,

ich hab hier noch mal ein kleines VBA-Problem welches für die meisten von euch wahrscheinlich ziemlich basic ist mir aber gerade großes Kopfzerbrechen und Performanceprobleme bereitet:

Ausgangssituation:
Tabelle "Liste" enthält (als Pivot) in Spalte B eine Liste mit ID-Nummern der zu kopierenden Datensätze, bspw.:
28
38
4
56
57
59
111
Tabelle "Quelle" enthält alle Datensätze in unsortierter Reihenfolge. Die o.g. genannte ID steht in Spalte A.
Tabelle "Ziel" enthält noch nichts, soll aber die Zeilen enthalten deren ID-Nummer in der "Liste" steht.

Bisheriger Ansatz:
Durchlaufe "Liste" mit for-Schleife bis zur letzten Zeile und durchsuche "Quelle" Spalte A für jede "Liste"n-zeile nach der ID. Wenn ID gefunden, kopiere komplette Zeile nach "Ziel".

Problem:
Mein Ansatz (s.o.) läuft bei gerade einmal 100 Datensätzen und ~40 Spalten ca. 30s. Da es bei jeder Veränderung einer Pivottabelle getriggert werden soll (bereits gelöst), ist so eine lange Laufzeit nicht praktikabel. Gibt es evtl. noch eine elegantere Methode?

Vielen Lieben Dank euch und ein schönes Wochenende!
Pochi

  

Betrifft: AW: Suchen und kopieren mit variabler Liste von: fcs
Geschrieben am: 01.08.2014 13:08:08

Hallo Pochi,

eine Möglichkeit zur Beschleunigung:
In der Quelltabelle mit dem Autofilter arbeiten, dann kann man alle Werte aus der Pivot als Array für die Filterwerte übergeben. Im Zielblatt müssen die kopierten Zeilen ggf. noch nach der ID-sortiert werden, wenn diese als Zeilenblöcke vorliegen sollen. Diese Methode kopiert allerdings keine Formeln, sondern nur Formate und Werte.

Zusätzlich kann evtl. noch Beschleunigung erreichen, indem während der Makroausführung die Bildschirmaktualiierung deaktiviert und der Berechnungsmodus auf Manuel geetzt wird.

Nachfolgend ein Beispielmakro. Tabellennamen sowie Zeilen und Spaltennummern musst du ggf. anpassen.
Gruß
Franz

Sub Filtern()
  Dim wksPivot As Worksheet, wksQ As Worksheet, wksZ As Worksheet
  Dim ZeileP As Long, ZeileQ As Long, ZeileZ As Long
  Dim arrFilter() As String, intF As Integer
  
  Set wksQ = ActiveWorkbook.Worksheets("Quelle")
  Set wksZ = ActiveWorkbook.Worksheets("Ziel")
  Set wksPivot = ActiveWorkbook.Worksheets("Pivot")
  
  'Filterwerte in Pivot in Array einlesen
  With wksPivot
    For ZeileP = 5 To .Cells(.Rows.Count, 2).End(xlUp).Row
      With .Cells(ZeileP, 2)
        If .Value <> "" Then
          intF = intF + 1
          ReDim Preserve arrFilter(1 To intF)
          arrFilter(intF) = .Text
        End If
      End With
    Next
  End With
  
  If intF > 0 Then
    With wksQ
      'Autofilter in Quelle vorbereiten
      If .AutoFilterMode = True Then
        If .FilterMode = True Then .ShowAllData
      Else
        ZeileQ = .Cells.SpecialCells(xlCellTypeLastCell).Row
        .Range(.Rows(1), .Rows(ZeileQ)).AutoFilter
      End If
      ZeileQ = .Cells.SpecialCells(xlCellTypeLastCell).Row
      'Autofilter setzen für Spalte mit ID-Werten
      .AutoFilter.Range.AutoFilter Field:=2, Criteria1:=arrFilter, Operator:=xlFilterValues
      ZeileQ = .Cells.SpecialCells(xlCellTypeLastCell).Row
      If ZeileQ = 1 Then
        MsgBox "keine Zeilen zu Filterwerten in Quelltabelle gefunden"
      Else
        'nächste freie Zeile in Spalte mit ID
        ZeileZ = wksZ.Cells(wksZ.Rows.Count, 2).End(xlUp).Row + 1
        .Range(.Rows(2), .Rows(ZeileQ)).Copy wksZ.Cells(ZeileZ, 1)
      End If
      'in Quelle alle Daten wieder anzeigen
      .ShowAllData
      
      'kopierte Daten in Zieltabelle nach der ID in Spalte B sortieren
      With wksZ
        With .Range(.Rows(ZeileZ), .Rows(.Cells(.Rows.Count, 2).End(xlUp).Row))
          .Sort key1:=.Range("B1"), Order1:=xlAscending, Header:=xlNo
        End With
      End With
      
    End With
    Erase arrFilter
  Else
    MsgBox "keine Filterwerte in Pivottabelle gefunden"
  End If
End Sub



  

Betrifft: AW: Suchen und kopieren mit variabler Liste von: Robert
Geschrieben am: 01.08.2014 13:12:55

Hallo Pochi,

Wie genau sieht denn dein Code aus?
Für eine einfach verschachtelte For...Next Schleife erscheinen mir 30 sek deutlich zu lang...
Um die Performance zu verbessern kannst du noch Events und Screenupdating ausschalten.

so könnte der Code beispielsweise aussehen:

Sub Suche()
Dim i, o As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False

For i = 1 To Worksheets("Liste").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    For o = 1 To Worksheets("Quelle").UsedRange.SpecialCells(xlCellTypeLastCell).Row
        If Worksheets("Liste").Cells(i, 2) = Worksheets("Quelle").Cells(o, 1) Then
            Worksheets("Quelle").Rows(o).Copy
            Worksheets("Ziel").Cells(Worksheets("Ziel").UsedRange.SpecialCells( _
xlCellTypeLastCell).Row, 1).PasteSpecial
            Exit For
        End If
    Next o
Next i

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
Viele Grüße
Robert


  

Betrifft: AW: Suchen und kopieren mit variabler Liste von: Robert
Geschrieben am: 01.08.2014 13:15:48

Kleine Korrektur (Habe beim Zielsheet immer die letzte benutzte und nicht die erste Zeile benutzt), einfach ein +1 an der richtigen Stelle:

Sub Suche()
Dim i, o As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False

For i = 1 To Worksheets("Liste").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    For o = 1 To Worksheets("Quelle").UsedRange.SpecialCells(xlCellTypeLastCell).Row
        If Worksheets("Liste").Cells(i, 2) = Worksheets("Quelle").Cells(o, 1) Then
            Worksheets("Quelle").Rows(o).Copy
            Worksheets("Ziel").Cells(Worksheets("Ziel").UsedRange.SpecialCells( _
xlCellTypeLastCell).Row + 1, 1).PasteSpecial
            Exit For
        End If
    Next o
Next i

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub



 

Beiträge aus den Excel-Beispielen zum Thema "Suchen und kopieren mit variabler Liste"