• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

vba code doet niets

  • Onderwerp starter Onderwerp starter jli
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
J

jli

Gebruiker
Lid geworden
14 feb 2008
Berichten
39
Hallo allemaal,

Code: 
Private Sub CommandButton2_Click()

Range("B1") = "Alles leegmaken."

Dim cl As Range

 Range("B9:O23") = ""
 Range("b1") = "E-mailadressen genereren."
     
      Teller = 0
    Regel = 9
    Waarde = ""
    Kolom = B
    For Each c1 In Range(Kolom & "34:" & Kolom & "1500")
     If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
          If Teller = 50 Then
                Range(Kolom & Regel).Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
       If Kolom = B Then Kolom = E Else
       If Kolom = E Then Kolom = G Else
       If Kolom = G Then Kolom = I Else
       If Kolom = I Then Kolom = K Else
       If Kolom = K Then Kolom = M Else
       If Kolom = M Then Kolom = O
            Next [COLOR="Blue"]cl[/COLOR]
    If Teller <> 0 Then Range(Kolom & Regel).Value = Left(Waarde, Len(Waarde) - 1)

Range("b1") = ""

End Sub

Deze code geeft een foutmelding:

Compileerfout
Ongeldige verwijzing naar besturingselement variable next

Wie weet waar dit aan kan liggen ?

Jurgen
 
Laatst bewerkt:
Beste jli ;)

Ik denk dat de cl achter Next weg moet.

Groetjes Danny. :thumb:
 
Beste Danny,

Nee, als ik dat doe krijg ik een foutmelding, op If cl <> "" Then

Jurgen
 
Je heb dit;
For Each c1
en je eindigt met dit
next cl

zoek de fout.
 
Huijb,

Ja dat klopt, dat heb ik ook gezien en al verandert.
Maar de code doet nu niets, hij geeft geen foutmelding.

Jurgen
 
Beste allemaal,

Dit is mijn huidige code:
Ik wilde hem een stuk korter maken omdat het iedere keer dezelfde routines zijn.

Code: 
Private Sub CommandButton2_Click()

Range("B1") = "Alles leegmaken."

Dim cl As Range

 Range("B9:O23") = ""
 Range("b1") = "E-mailadressen genereren."
 
    Teller = 0
    Regel = 9
    Waarde = ""
    For Each cl In Range("B34:B1500")
        If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
          If Teller = 50 Then
                Cells(Regel, "B").Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
    Next cl
    If Teller <> 0 Then Cells(Regel, "B").Value = Left(Waarde, Len(Waarde) - 1)
    
    Teller = 0
    Regel = 9
    Waarde = ""
    For Each cl In Range("E34:E1500")
        If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
            If Teller = 50 Then
                Cells(Regel, "E").Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
    Next cl
    If Teller <> 0 Then Cells(Regel, "E").Value = Left(Waarde, Len(Waarde) - 1)

    Teller = 0
    Regel = 9
    Waarde = ""
    For Each cl In Range("G34:G1500")
        If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
            If Teller = 50 Then
                Cells(Regel, "G").Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
    Next cl
    If Teller <> 0 Then Cells(Regel, "G").Value = Left(Waarde, Len(Waarde) - 1)

    Teller = 0
    Regel = 9
    Waarde = ""
    For Each cl In Range("I34:I1500")
        If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
            If Teller = 50 Then
                Cells(Regel, "I").Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
    Next cl
    If Teller <> 0 Then Cells(Regel, "I").Value = Left(Waarde, Len(Waarde) - 1)

    Teller = 0
    Regel = 9
    Waarde = ""
    For Each cl In Range("K34:K1500")
        If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
            If Teller = 50 Then
                Cells(Regel, "K").Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
    Next cl
    If Teller <> 0 Then Cells(Regel, "K").Value = Left(Waarde, Len(Waarde) - 1)

    Teller = 0
    Regel = 9
    Waarde = ""
    For Each cl In Range("M34:M1500")
        If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
            If Teller = 50 Then
                Cells(Regel, "M").Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
    Next cl
    If Teller <> 0 Then Cells(Regel, "M").Value = Left(Waarde, Len(Waarde) - 1)

      Teller = 0
    Regel = 9
    Waarde = ""
    For Each cl In Range("O34:O1500")
        If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
          If Teller = 50 Then
                Cells(Regel, "O").Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
    Next cl
    If Teller <> 0 Then Cells(Regel, "O").Value = Left(Waarde, Len(Waarde) - 1)

If Cells(9, "I") <> "" Then Range("A1") = "oke"
Range("b1") = ""

End Sub
 
jli,

Hierbij de aangepaste code die de kolommen afloopt op basis van een nummer:

Code: 
Private Sub CommandButton2_Click()

Range("B1") = "Alles leegmaken."

Dim cl As Range

 Range("B9:O23") = ""
 Range("b1") = "E-mailadressen genereren."
 Ltr = 2
 Volgende = 3
 For x = 1 To 7
    Teller = 0
    Regel = 9
    Waarde = ""
    For Each cl In Range(Cells(34, Ltr), Cells(1500, Ltr))
        If cl <> "" Then
            Waarde = Waarde & cl & ";"
            Teller = Teller + 1
          If Teller = 50 Then
                Cells(Regel, "B").Value = Left(Waarde, Len(Waarde) - 1)
                Regel = Regel + 1
                Teller = 0
                Waarde = ""
            End If
        End If
    Next cl
    If Teller <> 0 Then Cells(Regel, "B").Value = Left(Waarde, Len(Waarde) - 1)
    Ltr = Ltr + Volgende
    Volgende = 2
Next x

If Cells(9, "I") <> "" Then Range("A1") = "oke"
Range("b1") = ""

End Sub
 
Beste superzeeuw,

Hartelijk dank, voor het kleiner maken van jou/mijn code.
Ik was zelf ook al aan de gang geweest maar kon geen oplossing bedenken dat er tussen B en E 2 kolommen tussen zaten en de rest maar 1

Jij hebt het zo mooi opgelost, bedankt

Jurgen
 
Er stond nog een klein foutje in op 2 plaatsen:
"B" moet zijn Ltr

Jurgen
 
of vertaald naar VBA
Code: 
Private Sub CommandButton2_Click()
  Sheets(1).Range("B9:O23").clearcontents
  For j=3 to 15 step 2
     For jj=34 to 1500 step 50
        c3=c3 & replace(join(worksheetfunction.transpose(sheets(1).cells(jj,j).resize(50)),";"),";;","") & vbCr
     Next
  Next
  Sheets(1).cells(9,2).resize(ubound(split(c3,vbcr)))=worksheetfunction.transpose(split(c3,vbcr))
End Sub
 
Laatst bewerkt:
@jli,

Klopt helemaal wat je zegt, die tweemaal "B" had ik over het hoofd gezien.

@snb,

Jouw code voert de procedure uit met step 2 echter jli gaat van kolom B naar E naar G naar J etc.
Tussen kolom B en E zitten 2 kolommen ipv 1 kolom zoals daarna het geval is dus de eerste stap is geen 2 maar 3.
 
Superzeeuw zei:
@snb,

Jouw code voert de procedure uit met step 2 echter jli gaat van kolom B naar E naar G naar J etc.
Tussen kolom B en E zitten 2 kolommen ipv 1 kolom zoals daarna het geval is dus de eerste stap is geen 2 maar 3.
Klik om te vergroten...

Dit zou een oplossing kunnen zijn... (ongetest)
Code: 
Private Sub CommandButton2_Click()
  Sheets(1).Range("B9:O23").clearcontents
  For j=[COLOR="blue"]1 to 7[/COLOR]
     [COLOR="Blue"]x = Choose(j, 2,5,7,9,11,13,15)[/COLOR]
     For jj=34 to 1500 step 50
        c3=c3 & replace(join(worksheetfunction.transpose(sheets(1).cells(jj,[COLOR="blue"]x[/COLOR]).resize(50)),";"),";;","") & vbCr
     Next
  Next
  Sheets(1).cells(9,2).resize(ubound(split(c3,vbcr)))=worksheetfunction.transpose(split(c3,vbcr))
End Sub

Groet, Leo
 
Code: 
Private Sub CommandButton2_Click()
  Sheets(1).Range("B9:O23").clearcontents
  For j=3 to 15 step 2
     For jj=34 to 1500 step 50
        c3=c3 & replace(join(worksheetfunction.transpose(sheets(1).cells(jj,j-[COLOR="Blue"](j=3)[/COLOR])).resize(50)),";"),";;","") & vbCr
     Next
  Next
  Sheets(1).cells(9,2).resize(ubound(split(c3,vbcr)))=worksheetfunction.transpose(split(c3,vbcr))
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan