Office: (Office 2010) VBA Verborgene makro audführung

Helfe beim Thema VBA Verborgene makro audführung in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, ich habe ein sehr großes Makro erstellt, es wechselt zeihmlich oft die Seiten und zeigt mir alle Schritte am Bildschirm an, gibt es ein... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von schedl12, 16. Juli 2015.

  1. SCHEDL12
    schedl12 Neuer User

    VBA Verborgene makro audführung


    Hallo, ich habe ein sehr großes Makro erstellt, es wechselt zeihmlich oft die Seiten und zeigt mir alle Schritte am Bildschirm an, gibt es ein Möglichkeit das Makro auszuführen ohne das es mir am Bildschirm angezeigt und deshal schneller arbeitet?
    mfg
    josef
     
    schedl12, 16. Juli 2015
    #1
  2. EXL121150
    Exl121150 Erfahrener User
    Hallo Josef,

    deshalb nehme ich an, dass du das Makro mit Hilfe des Makrorekorders erstellt hast.

    Der Makrorekorder ist zwar ein sehr hilfreiches Werkzeug, mit dem man
    • auf die Schelle ein VBA-Programm erstellen kann
    • auch sofort sieht, wie die Excel-Arbeitsblattbearbeitung mittels VBA umgesetzt werden kann.
    Sein Nachteil ist jedoch, dass er übertrieben oft von der Select-Methode bzw. vom Selection-Objekt Gebrauch macht.
    Beide bewirken damit auch eine übertrieben oftmalige Aktualisierung der Bildschirmdarstellung und damit eine unnötige Verlangsamung des Programmablaufes.

    Man kann aber viele dieser vom Rekorder aufgerufenen SELECT-Methoden bzw. der eingesetzten SELECTION-Objekte durch RANGE(...)-Objekte ersetzen - nur muss man sich natürlich in der objektorientierten VBA-Programmierung auskennen, um nicht gewünschte Funktionalität zu verlieren bzw. sogar Fehlermeldungen oder - noch schlimmer - versteckte Fehler zu generieren.
     
    Exl121150, 16. Juli 2015
    #2
  3. SCHEDL12
    schedl12 Neuer User
    Hallo Anton, danke für deine Antwort und du hast recht ich habe das meiste mit dem Makrorekorder aufgenommen, dennoch würde ich gerne den Makro schneller machen, ich habe meinen Makrocode mal einzugefügt, vlt hat ja jemand eine Idee....;)

    Sub Sortieren()
    '
    ' Sortieren Makro
    '
    ' Tastenkombination: Strg+y
    '
    Sheets("Daten").Select
    Columns("A:AH").Select
    ActiveWorkbook.Worksheets("Daten").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Daten").Sort.SortFields.Add Key:=Range("I1:I1904") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Daten").Sort 'Am Anfang wird im Blatt Daten alle Einträge nach den Buchungsnamen sortiert'
    .SetRange Range("A1:U1904")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    Sheets("Tabelle9").Select
    Range("A2:F573").Select
    Selection.ClearContents ' Löschen von alten werten im Blatt Tabelle 9 '
    Sheets("Probe").Select
    Range("D4:I5").Select
    ActiveCell.FormulaR1C1 = "0" ' Im Blatt Probe werden alle Werte auf Null gesetzt '
    Range("D5").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("E5").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("G5").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("H5").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("I5").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("J7").Select
    Sheets("Daten").Select
    'Selection.AutoFilter
    'Columns("I:I").Select
    'Selection.AutoFilter
    'Selection.AutoFilter
    'Cells.Select '
    Range("I1").Activate
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$U$1888").AutoFilter Field:=9, Criteria1:="=100*", _
    Operator:=xlAnd
    Columns("I:I").Select ' Im Blatt Daten werden alle Buchungsnummer die mir 100 beginnen gefiltert '
    Selection.Copy
    Sheets("Tabelle9").Select
    Range("A2:A338").Select
    ActiveWindow.SmallScroll Down:=-15
    ActiveWindow.ScrollRow = 1
    Columns("A:A").Select
    ActiveSheet.Paste 'Einfügen in Blatt 9'
    Range("A2:A1554").Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$2:$A$1554").RemoveDuplicates Columns:=1, Header:=xlNo ' Duplikate werden Entfernt '
    ActiveWindow.ScrollRow = 1398
    ActiveWindow.ScrollRow = 1
    Range("A2:A1000").Select
    Selection.Copy
    Sheets("100...").Select
    Range("C2:AOC2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Rows("2:2").Select
    Application.CutCopyMode = False ' 100... Werte werden in das Blatt 100 eingefügt '
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung '
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Sheets("Daten").Select
    ActiveSheet.Range("$A$1:$U$1888").AutoFilter Field:=9, Criteria1:="=8*", _
    Operator:=xlAnd ' Im Blatt Daten werden alle Buchungsnummer die mir 800 beginnen gefiltert '
    Columns("I:I").Select
    Selection.Copy
    Sheets("Tabelle9").Select
    ActiveWindow.ScrollRow = 1398
    ActiveWindow.ScrollRow = 1
    Columns("B:B").Select
    ActiveSheet.Paste 'Einfügen in Blatt 9'
    Application.CutCopyMode = False
    ActiveSheet.Range("$B$1:$B$1046715").RemoveDuplicates Columns:=1, Header:= _
    xlNo ' Duplikate werden Entfernt '
    Range("B2:B1003").Select
    Selection.Copy
    Sheets("800...").Select
    Range("C2:AND2").Select ' 800... Werte werden in das Blatt 800 eingefügt '
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Rows("2:2").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Sheets("Daten").Select
    ActiveSheet.Range("$A$1:$U$1888").AutoFilter Field:=9, Criteria1:="=K*", _
    Operator:=xlAnd ' Im Blatt Daten werden alle Buchungsnummer die mir K. beginnen gefiltert '
    Columns("I:I").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=36
    Sheets("Tabelle9").Select
    ActiveWindow.ScrollRow = 1398
    ActiveWindow.ScrollRow = 1
    Columns("C:C").Select
    ActiveSheet.Paste 'Einfügen in Blatt 9'
    Application.CutCopyMode = False
    ActiveSheet.Range("$C$1:$C$1046730").RemoveDuplicates Columns:=1, Header:= _
    xlNo ' Duplikate werden Entfernt '
    Range("C2:C1011").Select
    Selection.Copy
    Sheets("K...").Select
    Range("C2:AOM2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True ' K... Werte werden in das Blatt K... eingefügt '
    Rows("2:2").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Sheets("Daten").Select
    Columns("I:I").Select
    Range("I168").Activate
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$I$1:$I$1888").AutoFilter Field:=1, Criteria1:="=E.*", _
    Operator:=xlAnd ' Im Blatt Daten werden alle Buchungsnummer die mir E. beginnen gefiltert '
    Columns("I:I").Select
    Selection.Copy
    Sheets("Tabelle9").Select
    ActiveWindow.ScrollRow = 1398
    ActiveWindow.ScrollRow = 2796
    ActiveWindow.ScrollRow = 1398
    ActiveWindow.ScrollRow = 1
    Columns("D:D").Select
    ActiveSheet.Paste 'Einfügen in Blatt 9'
    Application.CutCopyMode = False
    ActiveSheet.Range("$D$2:$D$1047490").RemoveDuplicates Columns:=1, Header:= _
    xlNo ' Duplikate werden Entfernt '
    ActiveWindow.SmallScroll Down:=-48
    Range("D2:D1014").Select
    Selection.Copy
    Sheets("E...").Select
    Range("C2:APC2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True ' E... Werte werden in das Blatt E... eingefügt '
    Rows("2:2").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Sheets("Daten").Select
    ActiveSheet.Range("$I$1:$I$1888").AutoFilter Field:=1, Criteria1:="=I.*", _
    Operator:=xlAnd ' Im Blatt Daten werden alle Buchungsnummer die mir I. beginnen gefiltert '
    Columns("I:I").Select
    Selection.Copy
    Sheets("Tabelle9").Select
    ActiveWindow.ScrollRow = 1398
    ActiveWindow.ScrollRow = 1
    Columns("E:E").Select
    ActiveSheet.Paste 'Einfügen in Blatt 9'
    Application.CutCopyMode = False
    ActiveSheet.Range("$E$1:$E$1046689").RemoveDuplicates Columns:=1, Header:= _
    xlNo ' Duplikate werden Entfernt '
    Range("E2:E1045").Select
    Selection.Copy
    Sheets("I...").Select
    Range("C2:AON2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True ' I... Werte werden in das Blatt I... eingefügt '
    Rows("2:2").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 'Formatierung'
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    'Sheets("Fehlbuchungen").Select
    'Range("A1:Y112").Select
    'Range("A6:V6").Select
    'Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    'Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    'Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    'Selection.Borders(xlEdgeTop).LineStyle = xlNone
    'Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    'Selection.Borders(xlEdgeRight).LineStyle = xlNone
    'Selection.Borders(xlInsideVertical).LineStyle = xlNone
    'Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    'With Selection.Interior
    '.Pattern = xlNone
    '.TintAndShade = 0
    '.PatternTintAndShade = 0
    'End With
    Sheets("Tabelle9").Select ' Tabelle 9 Formatierung bzw. neubezeichnung der Spaltennamen'
    ActiveWindow.SmallScroll Down:=-33
    ActiveWindow.ScrollRow = 1398
    ActiveWindow.ScrollRow = 1
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "100…"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "800…"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "K…"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "E…"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "I…"
    Range("A1:E1").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Rows("1:1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("A:E").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    With Selection.Borders(xlInsideVertical)
    .LineStyle = xlDouble
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThick
    End With
    'Sheets("I...").Select
    'Range("E43").Select
    'Sheets("E...").Select
    'Range("E43").Select
    'Sheets("K...").Select
    'Range("D44").Select
    'Sheets("800...").Select
    'Range("C44").Select
    'Sheets("100...").Select
    'Range("B47").Select
    'Sheets("Daten").Select
    Selection.AutoFilter
    ActiveWindow.SmallScroll Down:=-12
    Range("A1").Select
    Sheets("Probe").Select 'Ergebnisse der Stunden und der Buchungseinträge werden im Blatt Probe eingefügt'
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[11]C[1]:R[20]C[1])"
    Range("D4").Select
    Selection.AutoFill Destination:=Range("D4:I4"), Type:=xlFillDefault
    Range("D4:I4").Select
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("H4").Select
    Range("D5").Select
    ActiveCell.FormulaR1C1 = "='100...'!R[17]C[-2]"
    Range("E5").Select
    ActiveCell.FormulaR1C1 = "='800...'!R[18]C[-3]"
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "=K...!R[17]C[-4]"
    Range("G5").Select
    ActiveCell.FormulaR1C1 = "=E...!R[17]C[-5]"
    Range("H5").Select
    ActiveCell.FormulaR1C1 = "=I...!R[18]C[-6]"
    Range("J5").Select
    Sheets("Daten").Select
    Range("A1").Select
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False 'Autofilter wird ausgeschalten'
    Sheets("Probe").Select
    Range("A1").Select ' Bestimmte Endposition bei Blatt Probe auf Feld A1 '

    End Sub
     
    schedl12, 17. Juli 2015
    #3
  4. EXL121150
    Exl121150 Erfahrener User

    VBA Verborgene makro audführung

    Hallo Josef,

    ich habe deinen Makrorekorder-VBA-Code modifiziert: Die Select/Selection/ActiveCell...-Konstrukte sind jetzt möglichst entfernt, sodass ein ruhigerer und - hoffentlich - auch schnellerer Ablauf des Makros gegeben ist.

    Da ich jedoch keine testbaren Arbeitsblätter zur Verfügung hatte, musste ich die Modifizierung ohne echten Testlauf durchführen. Ich habe natürlich schon dort, wo ich mir nicht sicher war, Tests mit Daten von mir durchgeführt - aber wie gesagt, du müsstest den Code zumindest bei den 1. Läufen mit Vorsicht behandeln, damit dir keine Daten abhanden kommen bzw. beschädigt werden (zB. Kopie der Arbeitsmappe für Testzwecke).

    Insbesondere wusste ich nicht, wie eine Reihe von Bereichsangaben, die offensichtlich vom Rekorder so (als Konstanten) erzeugt wurden, bei geänderten Daten noch in dieser Weise gültig sind. Betroffen sind da die Bereiche in den Zeilen mit "...RemoveDuplicates..." und die RANGE(....)-Angaben für die Copy-Befehle.
    Code:
    Sub Sortieren()
 '
 ' Sortieren Makro
 '
 ' Tastenkombination: Strg+y
 '
 Dim WsDaten As Worksheet, WsTab9 As Worksheet, WsProbe As Worksheet
 
 'Objektzeiger auf 3 Arbeitsblätter der aktiven Arbeitsmappe ermitteln:
 With ActiveWorkbook
   Set WsDaten = .Worksheets("Daten")
   Set WsTab9 = .Worksheets("Tabelle9")
   Set WsProbe = .Worksheets("Probe")
 End With
 
 'Am Anfang werden im Blatt "Daten" alle Einträge nach den Buchungsnamen sortiert'
 With WsDaten.Sort
   With .SortFields
     .Clear
     .Add Key:=Range("I1:I1904"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   End With
   .SetRange Range("A1:U1904")
   .Header = xlGuess
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
 End With
 
 ' Löschen von alten Werten im Blatt Tabelle 9 '
 WsTab9.Range("A2:F573").ClearContents
 
 ' Im Blatt Probe werden alle Werte auf Null gesetzt '
 WsProbe.Range("D4:I5").Value = "0"
 
 
 '-------------------------------------------------------
 With WsDaten
   ' Im Blatt Daten werden alle Buchungsnummern, die mit 100 beginnen, gefiltert '
   .Range("A1").AutoFilter Field:=9, Criteria1:="=100*", Operator:=xlAnd
 
   'Blatt Daten Spalte I: Kopieren nach Blatt Tabelle9 Spalte A
   .Columns("I:I").Copy Destination:=WsTab9.Columns("A:A")
 End With
 Application.CutCopyMode = False
 
 With WsTab9
   .Range("$A$2:$A$1554").RemoveDuplicates Columns:=1, Header:=xlNo ' Duplikate werden Entfernt '
   .Range("A2:A1000").Copy
 End With
 With Worksheets("100...")
    .Range("C2:AOC2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False ' 100... Werte werden in das Blatt 100 eingefügt '
 
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung '
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "100..."
 '-------------------------------------------------------------------
 With WsDaten
   ' Im Blatt Daten werden alle Buchungsnummer, die mit 800 beginnen, gefiltert '
   .Range("A1").AutoFilter Field:=9, Criteria1:="=8*", Operator:=xlAnd
 
   'Spalte I des Blattes Daten kopieren nach Blatt Tabelle9 Spalte B
   .Columns("I:I").Copy Destination:=WsTab9.Columns("B:B")
 End With
 With WsTab9
   .Range("$B$1:$B$1046715").RemoveDuplicates Columns:=1, Header:=xlNo  ' Duplikate werden Entfernt '
   .Range("B2:B1003").Copy
 End With
 With Worksheets("800...")
    .Range("C2:AND2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False ' 800... Werte werden in das Blatt 800 eingefügt '
    
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "800..."
    
'--------------------------------------------
 With WsDaten
   ' Im Blatt Daten werden alle Buchungsnummer, die mit K. beginnen, gefiltert '
   .Range("A1").AutoFilter Field:=9, Criteria1:="=K*", Operator:=xlAnd
   .Columns("I:I").Copy Destination:=WsTab9.Columns("C:C")
 End With
 Application.CutCopyMode = False
 With WsTab9
   ' Duplikate werden Entfernt '
   .Range("$C$1:$C$1046730").RemoveDuplicates Columns:=1, Header:=xlNo
   .Range("C2:C1011").Copy
 End With
 With Worksheets("K...")
    .Range("C2:AOM2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False ' K... Werte werden in das Blatt K... eingefügt '
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "K..."
  
 '-----------------------------------------------------
 With WsDaten
   ' Im Blatt Daten werden alle Buchungsnummer, die mit E. beginnen, gefiltert '
   .Range("A1").AutoFilter Field:=9, Criteria1:="=E.*", Operator:=xlAnd
   .Columns("I:I").Copy Destination:=WsTab9.Columns("D:D")
 End With
 Application.CutCopyMode = False
 With WsTab9
   .Range("$D$2:$D$1047490").RemoveDuplicates Columns:=1, Header:=xlNo   ' Duplikate werden Entfernt '
   .Range("D2:D1014").Copy
 End With
 With Worksheets("E...")
    .Range("C2:APC2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False  ' E... Werte werden in das Blatt E... eingefügt '
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "E..."
 
 '--------------------------------------------------------------
 With WsDaten
   'Im Blatt Daten werden alle Buchungsnummer, die mit I. beginnen, gefiltert '
   .Range("A1").AutoFilter Field:=9, Criteria1:="=I.*", Operator:=xlAnd
   .Columns("I:I").Copy Destination:=WsTab9.Columns("E:E")
 End With
 Application.CutCopyMode = False
 With WsTab9
   .Range("$E$1:$E$1046689").RemoveDuplicates Columns:=1, Header:=xlNo  ' Duplikate werden Entfernt '
   .Range("E2:E1045").Copy
 End With
 With Worksheets("I...")
    .Range("C2:AON2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False ' I... Werte werden in das Blatt I... eingefügt '
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone 'Formatierung'
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "I..."
 '--------------------------------------
  
 With WsTab9 ' Tabelle 9 Formatierung bzw. Neubezeichnung der Spaltennamen'
    .Range("A1") = "100…"
    .Range("B1") = "800…"
    .Range("C1") = "K…"
    .Range("D1") = "E…"
    .Range("E1") = "I…"
    With .Range("A1:E1")
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlBottom
       .WrapText = False
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
    End With
    With .Rows("1:1")
       .Borders(xlDiagonalDown).LineStyle = xlNone
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideVertical).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    With .Columns("A:E")
       .Borders(xlDiagonalDown).LineStyle = xlNone
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       .Borders(xlEdgeRight).LineStyle = xlNone
       With .Borders(xlInsideVertical)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
    End With
 End With 'Tabelle9
 
 With WsDaten
   If .AutoFilterMode Then .AutoFilterMode = False 'Autofilter wird ausgeschalten'
 End With
 
 'Ergebnisse der Stunden und der Buchungseinträge werden im Blatt Probe eingefügt'
 WsProbe.Activate
 Range("D4").FormulaR1C1 = "=SUM(R[11]C[1]:R[20]C[1])"
 Range("D4").AutoFill Destination:=Range("D4:I4"), Type:=xlFillDefault
 Range("I4") = "0"
 Range("D5").FormulaR1C1 = "='100...'!R[17]C[-2]"
 Range("E5").FormulaR1C1 = "='800...'!R[18]C[-3]"
 Range("F5").FormulaR1C1 = "=K...!R[17]C[-4]"
 Range("G5").FormulaR1C1 = "=E...!R[17]C[-5]"
 Range("H5").FormulaR1C1 = "=I...!R[18]C[-6]"
 
 Range("A1").Select ' Bestimmte Endposition bei Blatt Probe auf Feld A1 '

End Sub
     
    Zuletzt bearbeitet: 18. Juli 2015
    Exl121150, 18. Juli 2015
    #4
  5. SCHEDL12
    schedl12 Neuer User
    Danke Anton das ist wirklich nett!
    ich haben deinen Code ausprobiert leider funktioniert er noch nicht ganz, bekomme immer wieder eine Makro Debug, angezeigt wird mir das ganz in er Zeile; .Range("A1").AutoFilter Field:=9, Criteria1:="=100*", Operator:=xlAnd
    Vlt könntest du mir nochmal helfen?;)
    Danke!
     
    schedl12, 20. Juli 2015
    #5
  6. EXL121150
    Exl121150 Erfahrener User
    Hallo Josef,

    im nachfolgenden Code habe ich folgende Änderung eingebaut:
    Der Autofilter im Arbeitsblatt "Daten" wird jetzt auf den gesamten verwendeten Bereich angewendet, wobei Spalte 9 (vermutlich Spalte I des Blattes) jeweils das Filterkriterium enthält.

    Das prinzipielle Problem bleibt weiter bestehen: Da ich keine testbaren Arbeitsblätter zu Verfügung habe, weiß ich nicht wirklich, ob das Ganze funktioniert. Insbesondere habe ich große Bedenken, was die vielen konstanten Bereichsangaben betrifft - diese wurden vermutlich vom Makrorekorder bei der Aufzeichnung eines konkreten Einzelfalles so gesetzt. Aber sie scheinen sich zum Teil auch zu widersprechen.

    Da vermutlich wegen des vorhin Gesagten noch mit weiteren Fehlermeldungen zu rechnen ist, wäre es schön, wenn du mir dann zweierlei mitteilen würdest:
    1) die Stelle, wo der Fehler aufgetreten ist (das hast du gemacht);
    2) die Fehlermeldung, die dabei angezeigt wurde. Auch das ist für mich sehr hilfreich, um den Fehler beseitigen zu können.

    Code:
    Sub Sortieren()
 '
 ' Sortieren Makro
 '
 ' Tastenkombination: Strg+y
 '
 Dim WsDaten As Worksheet, WsTab9 As Worksheet, WsProbe As Worksheet
 
 'Objektzeiger auf 3 Arbeitsblätter der aktiven Arbeitsmappe ermitteln:
 With ActiveWorkbook
   Set WsDaten = .Worksheets("Daten")
   Set WsTab9 = .Worksheets("Tabelle9")
   Set WsProbe = .Worksheets("Probe")
 End With
 
 'Am Anfang werden im Blatt "Daten" alle Einträge nach den Buchungsnamen sortiert'
 With WsDaten.Sort
   With .SortFields
     .Clear
     .Add Key:=Range("I1:I1904"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   End With
   .SetRange Range("A1:U1904")
   .Header = xlGuess
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
 End With
 
 ' Löschen von alten Werten im Blatt Tabelle 9 '
 WsTab9.Range("A2:F573").ClearContents
 
 ' Im Blatt Probe werden alle Werte auf Null gesetzt '
 WsProbe.Range("D4:I5").Value = "0"
 
 
 '-------------------------------------------------------
 With WsDaten
   ' Im Blatt Daten werden alle Buchungsnummern, die mit 100 beginnen, gefiltert '
   .UsedRange.AutoFilter Field:=9, Criteria1:="=100*", Operator:=xlAnd
   
   'Blatt Daten Spalte I: Kopieren nach Blatt Tabelle9 Spalte A
   .Columns("I:I").Copy Destination:=WsTab9.Columns("A:A")
 End With
 Application.CutCopyMode = False
 
 With WsTab9
   .Range("$A$2:$A$1554").RemoveDuplicates Columns:=1, Header:=xlNo ' Duplikate werden Entfernt '
   .Range("A2:A1000").Copy
 End With
 With Worksheets("100...")
    .Range("C2:AOC2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False ' 100... Werte werden in das Blatt 100 eingefügt '
 
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung '
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "100..."
 '-------------------------------------------------------------------
 With WsDaten
   ' Im Blatt Daten werden alle Buchungsnummer, die mit 800 beginnen, gefiltert '
   .UsedRange.AutoFilter Field:=9, Criteria1:="=8*", Operator:=xlAnd
 
   'Spalte I des Blattes Daten kopieren nach Blatt Tabelle9 Spalte B
   .Columns("I:I").Copy Destination:=WsTab9.Columns("B:B")
 End With
 With WsTab9
   .Range("$B$1:$B$1046715").RemoveDuplicates Columns:=1, Header:=xlNo  ' Duplikate werden Entfernt '
   .Range("B2:B1003").Copy
 End With
 With Worksheets("800...")
    .Range("C2:AND2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False ' 800... Werte werden in das Blatt 800 eingefügt '
    
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "800..."
    
'--------------------------------------------
 With WsDaten
   ' Im Blatt Daten werden alle Buchungsnummer, die mit K. beginnen, gefiltert '
   .UsedRange.AutoFilter Field:=9, Criteria1:="=K*", Operator:=xlAnd
   .Columns("I:I").Copy Destination:=WsTab9.Columns("C:C")
 End With
 Application.CutCopyMode = False
 With WsTab9
   ' Duplikate werden Entfernt '
   .Range("$C$1:$C$1046730").RemoveDuplicates Columns:=1, Header:=xlNo
   .Range("C2:C1011").Copy
 End With
 With Worksheets("K...")
    .Range("C2:AOM2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False ' K... Werte werden in das Blatt K... eingefügt '
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "K..."
  
 '-----------------------------------------------------
 With WsDaten
   ' Im Blatt Daten werden alle Buchungsnummer, die mit E. beginnen, gefiltert '
   .UsedRange.AutoFilter Field:=9, Criteria1:="=E.*", Operator:=xlAnd
   .Columns("I:I").Copy Destination:=WsTab9.Columns("D:D")
 End With
 Application.CutCopyMode = False
 With WsTab9
   .Range("$D$2:$D$1047490").RemoveDuplicates Columns:=1, Header:=xlNo   ' Duplikate werden Entfernt '
   .Range("D2:D1014").Copy
 End With
 With Worksheets("E...")
    .Range("C2:APC2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False  ' E... Werte werden in das Blatt E... eingefügt '
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone ' Formatierung'
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "E..."
 
 '--------------------------------------------------------------
 With WsDaten
   'Im Blatt Daten werden alle Buchungsnummer, die mit I. beginnen, gefiltert '
   .UsedRange.AutoFilter Field:=9, Criteria1:="=I.*", Operator:=xlAnd
   .Columns("I:I").Copy Destination:=WsTab9.Columns("E:E")
 End With
 Application.CutCopyMode = False
 With WsTab9
   .Range("$E$1:$E$1046689").RemoveDuplicates Columns:=1, Header:=xlNo  ' Duplikate werden Entfernt '
   .Range("E2:E1045").Copy
 End With
 With Worksheets("I...")
    .Range("C2:AON2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False ' I... Werte werden in das Blatt I... eingefügt '
    With .Rows("2:2")
       .Borders(xlDiagonalDown).LineStyle = xlNone 'Formatierung'
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 End With 'Blatt "I..."
 '--------------------------------------
  
 With WsTab9 ' Tabelle 9 Formatierung bzw. Neubezeichnung der Spaltennamen'
    .Range("A1") = "100…"
    .Range("B1") = "800…"
    .Range("C1") = "K…"
    .Range("D1") = "E…"
    .Range("E1") = "I…"
    With .Range("A1:E1")
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlBottom
       .WrapText = False
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
    End With
    With .Rows("1:1")
       .Borders(xlDiagonalDown).LineStyle = xlNone
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       With .Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideVertical).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    With .Columns("A:E")
       .Borders(xlDiagonalDown).LineStyle = xlNone
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       .Borders(xlEdgeRight).LineStyle = xlNone
       With .Borders(xlInsideVertical)
         .LineStyle = xlDouble
         .ColorIndex = xlAutomatic
         .TintAndShade = 0
         .Weight = xlThick
       End With
    End With
 End With 'Tabelle9
 
 With WsDaten
   If .AutoFilterMode Then .AutoFilterMode = False 'Autofilter wird ausgeschaltet'
 End With
 
 'Ergebnisse der Stunden und der Buchungseinträge werden im Blatt Probe eingefügt'
 WsProbe.Activate
 Range("D4").FormulaR1C1 = "=SUM(R[11]C[1]:R[20]C[1])"
 Range("D4").AutoFill Destination:=Range("D4:I4"), Type:=xlFillDefault
 Range("I4") = "0"
 Range("D5").FormulaR1C1 = "='100...'!R[17]C[-2]"
 Range("E5").FormulaR1C1 = "='800...'!R[18]C[-3]"
 Range("F5").FormulaR1C1 = "=K...!R[17]C[-4]"
 Range("G5").FormulaR1C1 = "=E...!R[17]C[-5]"
 Range("H5").FormulaR1C1 = "=I...!R[18]C[-6]"
 
 Range("A1").Select ' Bestimmte Endposition bei Blatt Probe auf Feld A1 '

End Sub
     
    Exl121150, 20. Juli 2015
    #6
Thema:

VBA Verborgene makro audführung

Die Seite wird geladen...

  1. VBA Verborgene makro audführung - Similar Threads - VBA Verborgene makro

  2. VBA in einer Zeile zu lang

    in Microsoft Excel Hilfe
    VBA in einer Zeile zu lang: Moin, mein VBA Code ist für eine Zeile zu lang. Kann mir einer helfen wie ich den auf 2 Zeilen aufteilen Kann? arrSchuhDaten = Array(Range("A6"), Range("F6"), Range("J6"), Range("A7"),...

  3. Listbox wird nicht breiter, Schriftgrösse ändert sich

    in Microsoft Excel Hilfe
    Listbox wird nicht breiter, Schriftgrösse ändert sich: Hallo, ich habe ein Formular dessen Breite ich mit der Maus ändern kann. Im Formular habe ich einen Rahmen und darin eine Listbox deren Breite an die Formularbreite angepasst wird....

  4. Kontrollkästchen aktivieren ohne VBA - wenn KK1 angekreuzt dann KK2 auch

    in Microsoft Excel Hilfe
    Kontrollkästchen aktivieren ohne VBA - wenn KK1 angekreuzt dann KK2 auch: Hallo zusammen, erstmal danke für all die Tipps und Kniffe, die ich ohne eigenen Thread gefunden und gelernt habe. Leider finde ich mein Thema nirgendwo... Aktuell habe ich zwei Spalten mit...

  5. Per Hyperlink ausgeblendetes Blatt einblenden

    in Microsoft Excel Hilfe
    Per Hyperlink ausgeblendetes Blatt einblenden: Hola ins Forum, ich bräuchte mal wieder eure Hilfe. Ich habe ein Tabellenblatt das mir als Register dient und wo Hyperlinks eingefügt sind um auf das dazugehörige Blatt zu springen. Diese Blätter...

  6. Bilder über VBA Größe und DPI ändern für Webshop

    in Microsoft Excel Hilfe
    Bilder über VBA Größe und DPI ändern für Webshop: Hallo Excel Spezialisten, Ich habe mir eine recht aufwendige Tabelle gebastelt, aus der ich Daten für meinen Webshop generiere und in einer .csv bereitstelle. Es werden neue Preislisten...

  7. VBA: Platzhalter ersetzen und evtl. leere Zeile einfügen

    in Microsoft Word Hilfe
    VBA: Platzhalter ersetzen und evtl. leere Zeile einfügen: Hallo zusammen, ich habe eine Word-Vorlage mit Platzhaltern, in die ich mit VBA Daten aus einer Excel-Datei einfüge (in eine Excel-Zeile schreibe ich alle Daten für ein neues Word-Dokument). So...

  8. Erstellung eines Dynamischen Kalenders (ggf. VBA)

    in Microsoft Word Hilfe
    Erstellung eines Dynamischen Kalenders (ggf. VBA): Guten Morgen an Alle, ich hoffe, es geht euch soweit gut :) Ich wende mich heute an euch, weil ich gerade vollkommen verzweifle und irgendwie so ganz und garnicht weiterkomme und irgendwie...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Akzeptieren Weitere Informationen...
    Information ausblenden