VBA vs Formel

[Rabe]

Hi Jörg,

offensichtlich. :05:

Danke!

[schauan]

Hallo Ralf,

Du musst bei snb's Code nur acht geben, falls Du irgendwo Formeln einsetzt oder noch einsetzen willst. Da in dem Code der komplette Bereich übernommen und dann zurückgeschrieben wird, sind die dann also weg

[Rabe]

Hallo snb,

hier nun das Ergebnis.

Zu diesem Teil:

Code:

For j = 1 To UBound(sn)
      sn(j, 46) = "n.d."
      sn(j, 47) = "n.d."
      'Datum geliefert:
      If IsDate(sn(j, 20)) Then
         'Jahr/Monat eintragen
         sn(j, 46) = Format(sn(j, 20), "yyyy / mm")
         'Jahr/Quartal eintragen
         sn(j, 47) = Format(sn(j, 20), "yyyy / q")
      End If

Das generelle Setzen von "n.d." vor der Prüfung, ob es ein Datum ist, gefällt mir.
Das Datum wird korrekt eingetragen, nur ist die "Standard"-Formatierung der Zelle wohl nicht richtig, es wird anstelle des / ein . angezeigt.

Der 2. Teil funktioniert korrekt nach Anpasssung der Spalte in sn.

[Rabe]

Hi André,

Du musst bei snb's Code nur acht geben, falls Du irgendwo Formeln einsetzt oder noch einsetzen willst. Da in dem Code der komplette Bereich übernommen und dann zurückgeschrieben wird, sind die dann also weg

Danke, das werde ich mir mal für die Zukunft merken.

[snb]

Benütze einfach:

Code:

sn(j, 46) = Format(sn(j, 20), "yyyy \/ mm")

[Rabe]

Hallo,

aah, maskieren des /.

Danke, klappt gut.

Nun noch eine Frage, bisher konsolidiere ich die Jahresblätter 2015 - 2018) ja mit dem folgenden Makro, das dauert 250 Sekunden.

Code:

Option Explicit
' ---------------------------------------------------------
'Deklaration der API-Funktion
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub Alle_Tabelle_Neu_erstellen()
   Dim loLetzte As Long
   Dim loZeile As Long
   Dim loZeileNeu As Long
   Dim j As Long
   Dim loStartTime As Long
  
   loStartTime = GetTickCount
  
   'AutoFilter Alle-Tabelle ausschalten
   Worksheets("Alle").Activate
      'Range("A2:AX2").Select
      'If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
  
   With Application
      .CalculateBeforeSave = True
      .Calculation = xlCalculationManual        'Tabelle Neuberechnung auf Manuell schalten
      .ScreenUpdating = False                   'Bildschirm akutalisieren ausschalten
   End With
  
   'Bestehende Daten löschen
   loZeileNeu = 14411   '1.Zeile im Blatt Alle zum einfügen, für 2015: Zeile 14411
   Range("A" & loZeileNeu, Range("AX" & loZeileNeu).End(xlDown)).Delete 'ClearContents
   loZeile = loZeileNeu
  
   For j = 2015 To year(Now)
      With Worksheets(CStr(j))
'         If .AutoFilterMode Then Range("A:A").AutoFilter
         loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row           ' letzte belegte in Spalte A (1)
         .Range("A2:AR" & loLetzte).Copy
      End With
      
      With Worksheets("Alle")
         .Range("A" & loZeile).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
             Operation:=xlNone, SkipBlanks:=False, Transpose:=False
         loZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1        ' erste freie in Spalte A (1)
      End With
      
      'AutoFilter Jahr-Tabelle einschalten
      Worksheets(CStr(j)).Select
      Range("A1:AR1").Select
      If Not ActiveSheet.AutoFilterMode Then Selection.AutoFilter
      Range("A2").Select
   Next j
  
   'Wiedereinschalten der Autofilterfunktion
   Worksheets("Alle").Select
      'Range("A2:AX2").Select
      'If Not ActiveSheet.AutoFilterMode Then Selection.AutoFilter
   Range("A" & loLetzte).Select
  
   With Application
      .CalculateBeforeSave = True
      .Calculation = xlCalculationAutomatic     'Tabelle Neuberechnung auf AUTOMATISCH
      .ScreenUpdating = True                    'Bildschirm akutalisieren einschalten
   End With
  
   MsgBox "Laufzeit " & _
       (GetTickCount - loStartTime) / 1000 & " Sekunden.", _
       vbInformation, "Laufzeit des Makros"
End Sub

Kann das durch Umstellung auf dieselbe Programmierung beschleunigt werden?

Code:

sn = Tabelle1.ListObjects("Tabelle24").DataBodyRange
   sp = Tabelle2.ListObjects("Tabelle1").DataBodyRange
[...]
  Tabelle1.ListObjects("Tabelle24").DataBodyRange=sn

[snb]

Meiner Vorschlag beabsichtete die 100% Ersetzung deiner Code.


Hast du mal getestet in der Datei ?

Oder lade mal ein kleine Beispieldatei hoch.