VBA en blanco regel in Excel

[Marky76]

Beste,

Ik heb volgende code:

Public Sub report()
Dim Tellerblad1
Dim Zoekwaarde

Tellerblad1 = 0
Range("J2").Select
Do Until ActiveCell.Offset(Tellerblad1, 0).Value = ""
Zoekwaarde = ActiveCell.Offset(1, 0).Value
If ActiveCell.Offset(Tellerblad1, 0).Value = Zoekwaarde Then
ActiveCell.Offset(Tellerblad1, 6).Value = 2006
Else
ActiveCell.Offset(Tellerblad1, 6).Value = 0
End If
Tellerblad1 = Tellerblad1 + 1
Loop

End Sub

Nu is het zo dat ik soms toch een lege rij heb. Hoe kan ik ervoor zorgen dat hij dan toch doorgaat en stopt op het einde van mijn bereik.

Groeten,

 

[Wigi]

Kijk eens naar FindNext in de helpfiles. Daar staat analoge en helemaal uitgewerkte, code.

 

[Marky76]

Wigi,
Hebt dit geprobeerd, maar werkt nog niet.

Public Sub report2()
Dim zoek As String
Dim eerstgevonden As String

zoek = InputBox("Geef de te zoeken tekst op:", "Zoekwaarde")
Range("A1").Select

If Not Cells.FindNext(After:=ActiveCell) Is Nothing Then
eerstgevonden = Cells.Find(zoek).Address
Cells.Find(What:=zoek, After:=ActiveCell).Activate
ActiveCell.Offset(0, 6).Value = 2006

While Cells.FindNext(After:=ActiveCell).Address <> eerstgevonden
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 6).Value = 2006
Wend
End If

End Sub

groeten, Mark

 

[Wigi]

Dit zie ik staan bij FindNext in de helpfiles:

With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

Probeer dit beter na te maken, en dichter bij deze code te blijven.

Die Worksheets(1).Range("a1:a500") moet je vervangen door het bereik waarin je zoekt.

Wigi

 

[Marky76]

Wigi,

Veder als dit heb ik het vandaag niet gebracht. Ga stillekes gaan slapen.
Kom nog teveel kennis te kort.
De If Not c Is Nothing Then moet ik toch lezen als "Als C niet niets is dan"

Public Sub report2()
Dim c
Dim zoek As String
Dim firstaddress
zoek = InputBox("Geef de te zoeken tekst op: ", "Zoekwaarde")

With Worksheets(1).Range("A21:O7")
Set c = .Find(What:=zoek, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = Cells.Find(zoek).Address
Do
Cells.Find(What:=zoek, After:= Activecell).Activate
ActiveCell.Offset(0, 6).Value = 2006
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With

End Sub

De code slaagt de Do loop over als ik met F8 overloop.

Groeten, Mark

 

[Wigi]

Tja, A21:O7 is natuurlijk ook niet echt juist hé...

Dit werkt wel naar behoren.

Public Sub report2()
    Dim c As Range
    Dim zoek As String
    Dim firstAddress As String
    zoek = Application.InputBox("Geef de te zoeken tekst op: ", "Zoekwaarde", Type:=2)

    With ActiveSheet.Range("J1").EntireColumn.SpecialCells(xlCellTypeConstants, 2)
        Set c = .Find(What:=zoek, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Offset(, 6).Value = 2006
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        Else
            MsgBox zoek & " werd niet gevonden."
        End If
    End With

End Sub

Leg het er maar eens naast en vergelijk rustig de veranderingen.

Wigi

 

[Marky76]

Wigi,

Ja, wakker was ik precies niet meer.
Ga het deze avond proberen en terug analyseren, ik schrijf dit ergens in Word op zodat ik
begrijp wat er allemaal staat.

Bedankt, Mark

 

[Marky76]

Wigi,

Als bewijs dat ik het probeer te leren heb je in bijlage een word bestandje waar ik jouw code wat probeer te analyseren.
Als je zin hebt, kan je dan eens lezen of hetgeen ik in het groen heb gezet tussen de code regels juist verwoord is.

Groeten, Mark

 

[Wigi]

Ik het het helemaal doorgenomen en verbeterd c.q. aangevuld.

Wigi

 

[Marky76]

Hey Wigi,

Dit is beter dan avondcursus volgen. Hiervan leer ik onmiddelijk iets.
Op deze manier vind ik leer je het beste.
Bedankt voor de supersnelle reactie! Sneller kan niet!

Groeten, Mark

 

[Wigi]

Sneller kan niet!

Jawel, maar ik was even een biertje gaan halen...

Neen, alle gekheid op een stokje. Ik denk dat dit idd erg nuttig was, ook jouw initiatief om het uit te schrijven/kopiëren. Ook anderen kunnen hier echt van leren.

Veel plezier ermee.

Wigi

 

[Marky76]

Wigi,

Ik heb nog een ander probleem op de site waar niet op gereageerd heb.
Het is wel redelijk complex.
"VBA kopiëren naar andere file met voorwaarden".

Kan jij eens kijken of het duidelijk is verwoord.

Groeten, Mark