loop maken: tot kolom leeg is

[arjoderoon]

ik heb een script voor een bepaalde bewerking die uitgevoerd moet worden voor iedere kolom vanaf kolom D totdat er een kolom komt die leeg is.
Dit zou makkelijk moeten kunnen middels de loop functie,

alleen hoe maak ik dat? ik heb verschillende loop functies gezien, maar ik snap de opbouw niet.

ik bijvoorbeeld onderstaande gevonden in een ander topic over een loop:

Private Sub CommandButton1_Click()
  For Each r In Range("B5:B200").SpecialCells(xlCellTypeFormulas)
    If r.Text <> "" Then r.Hyperlinks.Add r, Columns(5).Find(r.Text).Hyperlinks(1).Address
  Next
End Sub

de 2e regel snap ik deels. daarin wordt het bereik opgegeven waarin getest moet worden. De r in "For Each r" staat daarin neem ik aan voor 'row'. als ik deze vervang voor de c van column, gaat deze dan de kolommen testen en moet ik het bereik opgeven tot welke kolom er getest moet worden?
of kan ik het script ook zo maken dat deze zelf blijft gaan tot hij een lege kolom gevonden heeft? -> hoe doe ik dat?

het tweede gedeelte van de regel snap ik niet: het deel dat begint bij .SpecialCells
de tweede regel zegt iets over de test in de row. alleen de test erna snap ik vervolgens niet.

 

[Warme bakkertje]

Post je script eens dat moet uitgevoerd worden. De r is een zelf gekozen variabele en bedoelt eigenlijk 'Voor elke cel in het opgegeven bereik' . Dus bij elke next wordt de waarde van de nieuwe cel toegekend aan r waarmee dan weer de volgende bewerking kan uitgevoerd worden.

 

[arjoderoon]

het enige script dat ik nu heb is gegenereerd door de macro recorder.
maar dit is verre van efficient.
daarom zit ik te zoeken naar andere scripts en probeer ik daarvan te leren hoe de opbouw is zodat ik zelf een script zou kunnen maken.

Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Range("D2:D3").Select
    Selection.TextToColumns Destination:=Range("D2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1)

het eerste deel heeft als doel om ervoor te zorgen dat de spaties in het bereik verwijderd worden. dat is een eenmalige actie. Vanaf range("D23").select is het script dat gelooped moet worden.

(de tekst in de kolommen wordt naar getallen omgezet) ook dit kan ongetwijfeld beter maar het doel is om de waarden die er staan, gematched kunnen worden met een ander document.

dus eigenlijk moet er gechecked worden in de range van rij 1 waar de eerste lege cel gevonden worden. zolang er geen lege cellen gevonden worden moet de bewerking uitgevoerd worden.

volgens mij moet ik dus iets maken met do... until....

 

[arjoderoon]

wat ik nu heb (maar wat niet werkt)

Dim check As String
Sub copycells()

    Workbooks.Open Filename:="sap.xls"
    Cells.Select
    Selection.Copy
    Windows("voorbeeld helpmij 2.xls").Activate
    Sheets("data SAP").Activate
    '*** Select the destination cell
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWorkbook.Save
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False
    Application.CutCopyMode = False
    Workbooks("sap.xls").Close
    
    If Range("D1:AC1").Text = "" Then
    check = False
    
    Else: check = True
    
    End If
    
    Do Until check = "False"
    Range("D2:D3").Select
    Selection.TextToColumns Destination:=Range("D2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1)

    Exit Do
    Loop
    
    ActiveWorkbook.Save
End Sub

alleen dit doet niet wat het moet doen, maar dat komt ook doordat ik zelf niet snap hoe alles werkt.

doel:
het script moet vanaf cel d1 kijken of deze cel leeg is. Als dat niet zo is, moet voor alle niet-lege cellen vanaf cel D2 de spaties verwijderd worden en moet de kolom opgemaakt worden middels tekst naar kolommen.Als dat gedaan is, moet voor cel e1 gekeken worden of deze leeg is, als dat niet zo is, moet de kolom opgemaakt worden etc.

als vervolgens een cel aangetroffen wordt die wel leeg is, moet de functie/macro/loop gestopt worden want dan is alles gedaan.

dus er moet telkens een test uitgevoerd worden, vervolgens een bewerking, vervolgens moet er een cel naar rechts opgeschoven worden en dan moet de test weer uitgevoerd worden en ook weer de bewerking.

ik heb nog voor een vast aantal kolommen een scriptje maar daar krijg ik een error bij het tekst naar kolommen gedeelte:

Sub tekst()
Dim i As Integer
For i = 4 To 29
Columns(i).Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.TextToColumns Destination = Columns(i), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Next
end sub

het probleem zit hierbij in het 'destination = ' gedeelte.