VBA - vind tekst en replace getal ernaast

[Master070192]

Hallo iedereen,

Ik wil het e.e.a. automatiseren m.b.t. Administratie.

ik zit met het volgende probleem:

Ik zoek de volgende 2 strings met onderstaande methode:

Dim zin As String
zin = "Aanmaken nieuwe user"

Dim zin2 As String
zin2 = "Nieuwe token"

Vervolgens wil ik de cell rechts naast de strings, waar een getal in staat controleren. Als het getal groter is dan 0, wil ik het resetten naar 0.

Dit probeer ik op de volgende manier:

If String(zin).Offset(0, 1) >= 0 Then

zin.Offset(0, 1).Value = 0

Nu krijg ik de volgende error:

Compile error:


Syntax error.


Ik hoop dat iemand mij verder kan helpen, ik zit nogal vast.

 

[Master070192]

Dit moet gebeuren voor alle sheets.

 

[edmoor]

Je plaatst niet de hele code en laat ook niet weten op welke regel de fout zich voordoet. Plaats tevens je code in codetags.

 

[Peenvogel]

Hoi Master,
Ik heb maar zelf een voorbeeld bestand gemaakt, waar ik een macrootje heb opgenomen.
Hij zoekt nu in kolom A naar de door jou beschreven Strings en maakt in kolom B de waarde 0 als die aan de voorwaarde voldoet.
Een gedeelte van de code heb ik gebruikt uit een stukje code die ik van Cobbe heb gekregen.
Groetjes, Ron.

 

[Niels28]

nog een voorbeeld, ipv alle cellen een voor een door te lopen range.find gebruikt

Sub test()
    zin = "test"
    
    For sh = 1 To Sheets.Count
        Set c = Sheets(sh).Range("a1:A500").Find(zin)
        If Not c Is Nothing Then
            If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                r = c.Address
                Do
                Set c = Sheets(sh).Range("a1:A500").FindNext(After:=c)
                If Not c Is Nothing Then
                    If c.Address = r Then Exit Do
                    If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                End If
            Loop
        End If
    Next

End Sub

Niels

 

[Master070192]

De code van Peenvogel werkt perfect, ik heb nu dit:

Hoe kan ik specifieke tabbladen opgegeven, moet dit bij lrow = ?

Sub ResetValues()

Lrow = ActiveSheet.UsedRange.Rows.Count

    For i = Lrow To 1 Step -1
        b = 1 'maak van y het kolomnummer waarin gezocht moet worden
        
        If Cells(i, b).Value = "Aanmaken nieuwe user" And Cells(i, b + 1).Value > 0 Then
        Cells(i, b + 1).Value = 0
        End If
       
         
            If Cells(i, b).Value = "Nieuwe token" And Cells(i, b + 1).Value > 0 Then
            Cells(i, b + 1).Value = 0
            End If
    Next i
     
    
End Sub

 

[Peenvogel]

Nee, je moet de code van Niels gebruiken.
Toen jij postte had je nog niet gezegd dat dit voor alle werkbladen moest gelden en daarna postte je zelfs dat je bepaalde werkbladen uit wilt kiezen.
Niels heeft een prachtig stukje code geschreven, die inderdaad al jouw werkbladen afgaat.
Hij heeft ipv bv Nieuwe Token de string test gebruikt. Daar zou je dus nieuwe token of bv
je andere string kunnen invullen.

Na jouw verzoek om zelf de tabbladen aan te passen heb ik zelf de code van Niels iets aangepast.
Waar je Select case en daarna Case ziet moet je de nummers van de werkbladen invullen waar jij de routine uit wilt laten voeren.
In mijn voorbeeld heb ik gekozen voor werkblad nummer 2,4 en 6

Sub test2()
    zin = "Aanmaken nieuwe user"
    
    For sh = 1 To Sheets.Count

    Select Case sh
    Case 2, 4, 6
        
            Set c = Sheets(sh).Range("a1:A500").Find(zin)
        
            If Not c Is Nothing Then
            
                If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                r = c.Address
                
                    Do
                    
                        Set c = Sheets(sh).Range("a1:A500").FindNext(After:=c)
                        If Not c Is Nothing Then
                    
                            If c.Address = r Then Exit Do
                            
                                If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                                End If
                    Loop
                
                End If
            
    
    End Select

Next

zin2 = "Nieuwe token"

For sh = 1 To Sheets.Count

        
    Select Case sh
    Case 2, 4, 6
        
            Set c = Sheets(sh).Range("a1:A500").Find(zin2)
            
            If Not c Is Nothing Then
            
                If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                r = c.Address
                
                    Do
                        Set c = Sheets(sh).Range("a1:A500").FindNext(After:=c)
                
                            If Not c Is Nothing Then
                    
                                If c.Address = r Then Exit Do
                    
                                    If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                                    End If
                    Loop
               
                End If

    End Select

Next

End Sub

Waarschijnlijk kan het simpeler, maar mijn VBA vaardigheden schieten in vergelijking tot onze excel-goeroes ernstig te kort .
Groetjes, Ron.

 

[Peenvogel]

Misschien dat 1 van onze excel-goeroes er naar wil kijken om de code te vereenvoudigen?
Groetjes, Ron.

 

[edmoor]

Zoiets wellicht. Ik heb alleen naar de structuur gekeken en je mist een paar End If statements. Dat gebeurt dus bij onjuist gebruik van inspringpunten.

Sub test2()
    Call Herhaal("Aanmaken nieuwe user")
    Call Herhaal("Nieuwe token")
End Sub

Sub Herhaal(sToken As String)
    For sh = 1 To Sheets.Count
        Select Case sh
            Case 2, 4, 6
                Set c = Sheets(sh).Range("a1:A500").Find(zin)
                If Not c Is Nothing Then
                    If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                        r = c.Address
                        Do
                            Set c = Sheets(sh).Range("a1:A500").FindNext(After:=c)
                            If Not c Is Nothing Then
                                If c.Address = r Then Exit Do
                                    If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                                End If
                            End If
                        Loop
                    End If
                 End If
        End Select
    Next
End Sub

 

[Peenvogel]

Hoi Ed,
Ik heb jouw code geprobeerd, en heb die van jou en mij onder knopjes in het voorbeeldbestand gezet.
Jouw code ziet er mooi uit, maar om de een of andere reden zet hij nu in de Cellen A8 t/m A500 nu nullen neer. Misschien dat je ff het bestand wil testen? De knopjes staan op Blad 1. Als je dan eerst Code Ron(eigenlijk code Niels natuurlijk ) wilt doen en daarna Code Ed, zie je wat er gebeurt (even op blad 2, 4 en 6 de 2 nullen weer op 1 zetten).
Ik moest 2 end if-jes uit jouw code verwijderen, misschien dat het daaraan ligt.
Groetjes, Ron.

 

[edmoor]

Dat zei ik. Ik heb alleen naar de structuur gekeken die ik nogal verwarrend vond en onnodig veel code. De uiteindelijke werking liet ik even buiten beschouwing. Misschien dat ik er vandaag nog tijd voor heb om ook te werking te testen maar gezien het mooie weer verwacht ik dat niet

Qua structuur had ik er inderdaad nog 2 foutjes in zitten, dat is in deze aangepast:

Sub Herhaal(sToken As String)
    For sh = 1 To Sheets.Count
        Select Case sh
            Case 2, 4, 6
                Set c = Sheets(sh).Range("a1:A500").Find(zin)
                If Not c Is Nothing Then
                    If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                    r = c.Address
                    Do
                        Set c = Sheets(sh).Range("a1:A500").FindNext(After:=c)
                        If Not c Is Nothing Then
                            If c.Address = r Then Exit Do
                            If c.Offset(0, 1).Value >= 0 Then c.Offset(0, 1).Value = 0
                        End If
                    Loop
                End If
        End Select
    Next
End Sub

 

[Peenvogel]

Geen probleem, veel plezier in de zon en bv een lekkere kouwe Hertog Jan.
Groetjes, Ron.:thumb:

 

[edmoor]

Dat zal toch Grolsch moeten zijn

 

[Peenvogel]

Haha, nou `k ben een geboren en getogen Rotterdammer, dus ik hou het bij Heineken

 

[edmoor]

Ik niet. Ik heb liever een biertje
Maar we dwalen af.

 

[VenA]

Een Hein en Ineke drinker uit Enschede:shocked: en een Zuid-Hollander die Grolsch drinkt:thumb: Gekker moet het niet worden hier.:d

On topic.

Andere methode

Sub VenA()
blad = Array("Blad2", "Blad4", "Blad5")
s = InputBox("Wat wil u zoeken", "Resetten")

For Each sh In Sheets
    If UBound(Filter(blad, sh.Name)) >= 0 Then
        ar = sh.Cells(1).CurrentRegion
        For j = 1 To UBound(ar)
            If InStr(1, ar(j, 1), s) And ar(j, 2) > 0 Then ar(j, 2) = 0
        Next j
    sh.Cells(1).Resize(UBound(ar), 2) = ar
    End If
Next sh
End Sub

 

[HSV]

Iets anders.

For Each sh In Sheets(Array("Blad2", "Blad4", "Blad5"))

 

[Peenvogel]

Dank aan de goeroes voor het reageren, zeer leerzaam voor mij om te zien hoe de verschillende oplossingen
de vraag van de draadjes-starter steeds mooier beantwoordden.
Groetjes, Ron.

 

[Warme bakkertje]

Aangezien er al voldoende on-topic antwoorden zijn ff off-topic

Als belg zijnde krijg ik het warm en oud bij wat jullie een biertje noemen

 

[edmoor]

Daar heb je helemaal gelijk in. Dat is pilsener en geen bier. Toch wordt dat bij ons in de volksmond "een biertje" genoemd. Maar zo hebben de Belgen ook namen voor dingen die wij dan weer gek vinden Als we maar lol hebben

Daarnaast komen de goede bieren wat mij betreft inderdaad uit België