VBA-Abfrage vereinfachen bzw. verkürzen

Hallo Experten,
Ich hab ein Problem mit folgender Abfrage. Und zwar gehts hier darum dass gecheckt wird ob der Datensatz "end of data" heisst, falls nein müssen die Daten dazwischen ein bisschen formatiert werden, bevor die Abfrage im Anschluss an die formatierten Daten wieder von vorne beginnt. Falls der Datensatz "end of data" heisst soll, die Abfrage zuende sein.
Meine Version sieht so aus
If ActiveCell = "end of data" Then
Else
ActiveCell.Offset(-1, -1).Select
Selection.ClearContents
Range(Selection, Selection.End(xlToRight)).Select
Selection.Interior.ColorIndex = 36
Selection.Font.ColorIndex = 1
Selection.Font.Bold = True
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=R[1]C[-1]"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 1
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.Offset(1, 2).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Interior.ColorIndex = 8
Selection.Font.Bold = True
ActiveCell.Offset(-1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
End If
Das Problem bei dieser Version ist dass die Abfrage sehr lange wird. Gibts eine andere Möglichkeit eine solche Abfrage zu starten?
Danke für Eure Hilfe, Gruss Andi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andi,
hier ein Beispiel wie man dein Problem in einer Do-Loop-Schleife bearbeiten kann.
Ich hab im Code auch noch ein paar Aktionen eingebaut, wenn EndOfData-Zeile erreicht wird.
Gruß


Sub aatest1()
Dim Zeile1 As Long, Zeile2 As Long, ZeileLetzte
Dim ZeileSumme1 As Long
Dim Bereich As Range, Zelle As Range
Const Farbe1 As Long = 36 'Nummer der Füllfarbe
Const Farbe2 As Long = 22 'Nummer der Füllfarbe für Summenzeile
Const SpalteEndOfData = 1
'Letzte ausgefüllte Zeile in End of Data - Spalte  ermitteln
With ActiveSheet
ZeileLetzte = .Cells(.Rows.Count, SpalteEndOfData).End(xlUp).Row
End With
'Startzelle setzen
Zeile1 = 2
'prüfen, ob Startzelle Daten enhält, ggf. Startzelle neu setzen
If IsEmpty(Cells(Zeile1, SpalteEndOfData)) Then
Set Zelle = Cells(Zeile1, SpalteEndOfData).End(xlDown)
Zeile1 = Zelle.Row
Else
Set Zelle = Cells(Zeile1, SpalteEndOfData) 'Zelle A2
End If
ZeileSumme1 = Zeile1 '1. Zeile für Summenformel merken
Do
If Zelle = "end of data" Then
'### Aktionen rund um die "End of Data"-zeile
'In Zeile oberhalb Summenzeile einfügen
Zelle.Offset(-1, 0).Value = "Summe"
'Summenformel in rechter Nachbarzelle von Summe erstellen
Zelle.Offset(-1, 1).Formula = "=Sum(R[-" & Zelle.Row - ZeileSumme1 - 1 _
& "]C[0]:R[-1]C[0])"
'Summe + Summenformel farbig + Fett formatieren
With Range(Zelle.Offset(-1, 0), Zelle.Offset(-1, 1))
.Interior.ColorIndex = Farbe2
.Font.Bold = True
End With
'Inhalte in End of Data - Zeile löschen
Zelle.EntireRow.ClearContents
'### ab hier müssen die Zeilen für die Schleife erhalten bleiben
'Zeile1 für nächsten Block auf 1. Zeile nach EndOfData-zelle setzen
Zeile1 = Zeile1 + 1
ZeileSumme1 = Zeile1 '1. Zeile für Summenformel merken
If Zeile1 >= ZeileLetzte Then Exit Do
Set Zelle = Cells(Zeile1, SpalteEndOfData)
Else
'Zeile vor nächster Leerzeile ansteuern
Zeile2 = Zelle.End(xlDown).Row
'Ab Zelle nach rechts alle ausgefüllten Zellen formatieren bis zur Zeile2
With Range(Zelle, Cells(Zeile2, Zelle.End(xlToRight).Column))
.Interior.ColorIndex = Farbe1
End With
'1. Zeile des nächsten ausgefüllte Zellenblocks in ermitteln
Zeile1 = Cells(Zeile2, Zelle.Column).End(xlDown).Row
If Zeile1 > ZeileLetzte Then Exit Do 'Ausgang wenn letzte Zeile nicht endofdata
'Zelle = Starzelle des nächsten Blocks setzen
Set Zelle = Cells(Zeile1, SpalteEndOfData)
End If
Loop
End Sub

Beliebteste Forumthreads (12 Monate)

VBA-Abfrage vereinfachen bzw. verkürzen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA-Abfrage vereinfachen bzw. verkürzen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread