Do...Until Loop in Makro einbauen
Julius
ich hab ein relativ komplexes Makro und keine Erfahrung mit Schleifen, ich hab jezt mal ein bisschen recherchiert und meine, dass ich ein Do...Until Schleife brauche.
Die schleife müsste das Makro so lange ausführen, wie Werte in Spalte A sind angefangen bei Zelle "A11", sobald es auf die erste leer Zelle in A stößt, soll die Schleife enden. Die Schwierigkeit, die ich habe bei programmieren hier von ist, dass ich mehrere variable Zellen hab, damit mein ich, dass ich fixierte Zellen hab und welche die bewusst gewählt sind d.h. die Schleife sollte die Differenzen zwischen den variablen Zellen gleich belassen.
Hier der Code:
Sub Webabfrage()
Sheets("Tabelle1").Select
Application.Run "BLPLinkReset"
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("AB578").Value _
, Destination:=Range("AG578"))
.Name = "institutDetails.do?cmd=loadInstitutAction&institutId=123024"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'Überprüfen Inhalt
Dim rng As Range
For Each rng In Range("$AG$10:$AG$825")
If rng.Value = "Abschlußvermittlung (§ 1 Abs. 1a Satz 2 Nr. 2 KWG)" Or rng.Value = " _
Anlageverwaltung (§ 1 Abs. 1a Satz 2 Nr. 11 KWG)" Or rng.Value = "Factoring (§ 1 Abs. 1a Satz 2 Nr. 9 KWG)" Then
Range("$AG$1") = "1"
End If
Next
'Select what to do
For Each rng In Range("$AG$10:$AG$825")
If Range("$AG$1") = "" Then
Dim var As Variant
Dim iRow As Integer, iRowL As Integer
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = iRowL To 1 Step -1
var = Application.Match("*BaFin (Link zur Startseite)*", Rows(iRow), 0)
If Not IsError(var) Then
Rows(iRow).Delete
End If
Next iRow
End If
Next
'Delete Useless Content
Range("AG:AG").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="*Factoring*", Operator:=xlOr, _
Criteria2:="*Leasing*"
Range("$AG$1:$AN$887").ClearContents
'Zelle wählen
Range("AG632").Select
'Suchen Transponieren Abs
Dim wks As Worksheet
Dim ZelleStart As Range
Dim DeltaZeile As Long
Dim Bereich As Range, Zeile_L As Long
Set wks = ActiveSheet
DeltaZeile = 54 'Anzeilen, um die die Zellen mit "Abs." nach oben verschoben werden sollen
Set ZelleStart = Selection
'Wordbox ehemalig
With wks
'falls aktiv, dann Autofilter deaktivieren
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
.AutoFilterMode = False
End If
'Prüfen von Spalte und Zeile der selektierten Startzelle
If ZelleStart.Column = .Range("$AG$1").Column _
And ZelleStart.Row > DeltaZeile _
And ZelleStart.Cells.Count = 1 Then
'Selektion ist ok
Else
MsgBox "Startzelle für Makro muss einzelne Zelle in Spalte AG sein, " _
& "unterhalb von Zeile " & DeltaZeile, _
vbInformation + vbOKOnly, _
"Selektierte Zelle: " & ZelleStart.Address
Exit Sub
End If
'letzte Datenzeile in Spalten AG:AN
With .Range("AG:AN")
Set Bereich = .Find(after:=.Range("A1"), What:="*", LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
End With
If Bereich Is Nothing Then
MsgBox " Keine Daten in Spalten AG:AN"
Exit Sub
Else
Zeile_L = Bereich.Row
If Zeile_L *Abs.*"
'Inhalt in sichtbaren Zellen löschen
Set Bereich = .Range(ZelleStart.Offset(1, 0), .Cells(Zeile_L, ZelleStart.Column))
Bereich.ClearContents
wks.ShowAllData
wks.AutoFilterMode = False
'leere Zellen löschen
If Application.WorksheetFunction.CountBlank(Bereich) > 0 Then
Bereich.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
End If
'neue Letztezeile in Spalte AG
Zeile_L = .Cells(.Rows.Count, ZelleStart.Column).End(xlUp).Row
If Zeile_L *Abs.*", Operator:=xlAnd
Selection.ClearContents
Range("AG578").Select
End Sub
Alle variablen Zellenwerte die hier eingetragen sind wie z.B. hier am Schluss des Makros "Range("AG578").select" sollten durch die Schleife zu "Range("AG579").select" werden.Geht das? Kann mir da jemand helfen?
Mit freundlichen Grüßen,
Julius