foutmelding in macro

Status
Niet open voor verdere reacties.
J

jantje1

Gebruiker
Lid geworden
7 okt 2009
Berichten
49
Heb een macro lopen en deze werkt niet op alle excell docomenten,krijg namelijk onderstaande foutmelding te zien.
rest = Mid(waarde, r, Len(waarde))

Code: 
Sub ToevoegenGetal()
'
' Macro1 Macro
' De macro is opgenomen op 19/03/2011 door Jan.
'
' Sneltoets: CTRL+h


Dim r, z
    Dim rng As Range, cel As Range
    Dim waarde As String, nieuwwaarde As String
    Dim rest As String
    Dim teller As Long
    teller = 0
    Set rng = Sheets("blad2").Range("A1", Sheets("blad2").Range("A65536").End(xlUp))
    For Each cel In rng
        waarde = cel
        If Left(waarde, 1) <> ":" Then
        
            teller = teller + 10
            z = 1
            r = InStr(z, waarde, " ")
            rest = Mid(waarde, r, Len(waarde))
            nieuwwaarde = "N" & teller & "  " & rest
        
            cel.Offset(0, 9) = nieuwwaarde
        Else
            
        z = 1
            r = InStr(z, waarde, " ")
            rest = Mid(waarde, r, Len(waarde))
            nieuwwaarde = Left(waarde, r) & "  " & rest
        
            cel.Offset(0, 9) = nieuwwaarde
            End If
            
            
            
    Next
    
        Columns("A:I").Select
    Selection.Delete Shift:=xlToLeft
End Sub
 
Laatst bewerkt door een moderator:
Code: 
Sub ToevoegenGetal()
'
' Macro1 Macro
' De macro is opgenomen op 19/03/2011 door Jan.
'
' Sneltoets: CTRL+h


Dim r, z
    Dim rng As Range, cel As Range
    Dim waarde As String, nieuwwaarde As String
    Dim rest As String
    Dim teller As Long
    teller = 0
    Set rng = Sheets("blad2").Range("A1", Sheets("blad2").Range("A65536").End(xlUp))
    For Each cel In rng
        waarde = cel
        If Left(waarde, 1) <> ":" Then
        
            teller = teller + 10
            z = 1
            r = InStr(z, waarde, " ")
            rest = Mid(waarde, r, Len(waarde))
            nieuwwaarde = "N" & teller & "  " & rest
        
            cel.Offset(0, 9) = nieuwwaarde
        Else
            
        z = 1
            r = InStr(z, waarde, " ")
            rest = Mid(waarde, r, Len(waarde))
            nieuwwaarde = Left(waarde, r) & "  " & rest
        
            cel.Offset(0, 9) = nieuwwaarde
            End If
            
            
            
    Next
    
        Columns("A:I").Select
    Selection.Delete Shift:=xlToLeft
End Sub
 
Laatst bewerkt door een moderator:
Kijk eens of hij het nu wel doet.
De volgende keer graag de code selecteren en dan boven in het menu op # klikken, komt je code in een apart vak te staan.
Code: 
Sub ToevoegenGetal()
'
' Macro1 Macro
' De macro is opgenomen op 19/03/2011 door Jan.
'
' Sneltoets: CTRL+h
Dim r, z
Dim rng As Range, cel As Range
Dim waarde As String, nieuwwaarde As String
Dim rest As String
Dim teller As Long
teller = 0
Set rng = Sheets("blad2").Range("A1", Sheets("blad2").Range("A65536").End(xlUp))
For Each cel In rng
waarde = ActiveCell
If Left(waarde, 1) <> ":" Then

teller = teller + 10
z = 1
r = InStr(z, waarde, " ")
rest = Mid(waarde, 1, Len(waarde))
nieuwwaarde = "N" & teller & " " & rest

cel.Offset(0, 9) = nieuwwaarde
Else

z = 1
r = InStr(z, waarde, " ")
rest = Mid(waarde, r, Len(waarde))
nieuwwaarde = Left(waarde, r) & " " & rest

cel.Offset(0, 9) = nieuwwaarde
End If

Next

Columns("A:I").Select
Selection.Delete Shift:=xlToLeft
End Sub
 
De macro voert wel uit maar krijg enkel nummering te zien.
Kan ik je eventueel de file doorsturen?
 
Heb je in blad2 wel een getal ingevoerd?
B.V.B. 55 in A1

Ik heb dit gedaan en er kwam N10 55 te staan.
 
Hier komt er enkel n10 te staan en geen n10 55.
N100 L70 R49=0
N120 G59 Z40
N103 G0 G55 X-852 Y-203.5 Z100 W-40 T0
N101L78
N110 L89 R02=-135 R03=-165 R09=1.810 R10=200 M8
N130 G0 G80 Z200
N L70 R49=180
Het is de bedoeling van dit hier via de macro te hernummeren en optellend met 10

Vb: zo zou het moeten komen te staan:
N10 L70 R49=0
N20 G59 Z40
N30 G0 G55 X-852 Y-203.5 Z100 W-40 T0
N40 L78
N50 L89 R02=-135 R03=-165 R09=1.810 R10=200 M8
N60 G0 G80 Z200
N70 L70 R49=180
 
Ik heb de code weer terug gezet.
Het bevenste stuk wat er moet staan in Het blad gezet in A1
De code laten lopen en er kwam inderdaad uit wat jij wil hebben.
Code: 
Sub ToevoegenGetal()
'
' Macro1 Macro
' De macro is opgenomen op 19/03/2011 door Jan.
'
' Sneltoets: CTRL+h
Dim r, z
Dim rng As Range, cel As Range
Dim waarde As String, nieuwwaarde As String
Dim rest As String
Dim teller As Long
teller = 0
Set rng = Sheets("blad2").Range("A1", Sheets("blad2").Range("A65536").End(xlUp))
For Each cel In rng
waarde = cel
If Left(waarde, [COLOR="red"]1[/COLOR]) <> ":" Then

teller = teller + 10
z = 1
r = InStr(z, waarde, " ")
rest = Mid(waarde, 1, Len(waarde))
nieuwwaarde = "N" & teller & " " & rest

cel.Offset(0, 9) = nieuwwaarde
Else

z = 1
r = InStr(z, waarde, " ")
rest = Mid(waarde, r, Len(waarde))
nieuwwaarde = Left(waarde, r) & " " & rest

cel.Offset(0, 9) = nieuwwaarde
End If

Next

Columns("A:I").Select
Selection.Delete Shift:=xlToLeft
End Sub
 
Het werkt gedeeltelijk, krijg nu een dubbele nummering te zien:

N30 N10 (DIR/H17 V300 ALGEMEEN)
N40 N15 (A71 QVH 4OPSP RONDOM TYPE V300 V310 V330 V410 V430 ALGEMEEN )
N50 N20 M01 (A69 H17 V300 V430 RONDOM)
N60 N25 (DIR/H17 V300 ALGEMEEN)
N70 N30 (A71 QVH 4OPSP RONDOM TYPE V300 V310 V330 V410 V430 ALGEMEE)
Is het mogelijk van de tweede nummering weg te krijgen?
 
Dit is zeker voor het CNC gebeuren?

Volgens mij doet hij het nu goed.
Code: 
Sub ToevoegenGetal()
'
' Macro1 Macro
' De macro is opgenomen op 19/03/2011 door Jan.
'
' Sneltoets: CTRL+h
Dim r, z
Dim rng As Range, cel As Range
Dim waarde As String, nieuwwaarde As String
Dim rest As String
Dim teller As Long
teller = 0
Set rng = Sheets("blad2").Range("A1", Sheets("blad2").Range("A65536").End(xlUp))
For Each cel In rng
waarde = cel
If Left(waarde, 1) <> ":" Then

teller = teller + 10
z = 1
r = InStr(z, waarde, " ")
rest = Mid(waarde, [COLOR="red"]6[/COLOR], Len(waarde)) 
nieuwwaarde = "N" & teller & " " & rest

cel.Offset(0, 9) = nieuwwaarde
Else

z = 1
r = InStr(z, waarde, " ")
rest = Mid(waarde, r, Len(waarde))
nieuwwaarde = Left(waarde, r) & " " & rest

cel.Offset(0, 9) = nieuwwaarde
End If

Next

Columns("A:I").Select
Selection.Delete Shift:=xlToLeft
End Sub
 
Weet niet maar krijg nog steeds dubbele nummering
N110 N50 M01 (A69 H17 V300 V430 RONDOM)
N120 N60 (DIR/H17 V300 ALGEMEEN)
N130 N65 (A71 QVH 4OPSP RONDOM TYPE V300 V310 V330 V410 V430 ALGEMEEN )
N140 N70 M01 (A69 H17 V300 V430 RONDOM)
N150 N80 (DIR/H17 V300 ALGEMEEN)
N160 N90 (A71 QVH 4OPSP RONDOM TYPE V300 V310 V330 V410 V430 ALGEMEEN )
Inderdaad dit is voor cnc programma's te hernummeren
 
Sorry de laatste werkt wel maar nu verlies ik enkele karakters zie hieronder:
N270 600=0 (materiaalcode)
N280 11=0 R12=685.08 R13=450 R14=0 R15=0 (B0 G54 Xnpv GROTE BORING Y VERZAMELVLAK )
N290 21=0 R22=685.08 R23=455 R24=0 R25=0 (B90 G55 Xnpv MIDDEN Y VERZAMELVLAK )
N300 31=0 R32=685.08 R33=455 R34=0 R35=0 (B180 G56 Xnpv GROTE BORING Y VERZAMELVLAK)

N280 11=0 zou R11=0 moeten zijn de R is hier weggelaten
 
jantje1,

Ik heb de code met F8 laten lopen ( als je de cursor op een variable houd zie je de verandering)
Bij mij kwam dit er uit.

N10 L70 R49=0
N20 G59 Z40
N30 G0 G55 X-852 Y-203.5 Z100 W-40 T0
N40 78
N50 L89 R02=-135 R03=-165 R09=1.810 R10=200 M8
N60 G0 G80 Z200
N70 R49=180
N80 M01 (A69 H17 V300 V430 RONDOM)
N90 (DIR/H17 V300 ALGEMEEN)
N100 (A71 QVH 4OPSP RONDOM TYPE V300 V310 V330 V410 V430 ALGEMEEN )
N110 M01 (A69 H17 V300 V430 RONDOM)
N120 (DIR/H17 V300 ALGEMEEN)
N130 (A71 QVH 4OPSP RONDOM TYPE V300 V310 V330 V410 V430 ALGEMEEN )
N140 600=0 (materiaalcode)
N150 R11=0 R12=685.08 R13=450 R14=0 R15=0 (B0 G54 Xnpv GROTE BORING Y VERZAMELVLAK )
N160 21=0 R22=685.08 R23=455 R24=0 R25=0 (B90 G55 Xnpv MIDDEN Y VERZAMELVLAK )
 
Sorry maar krijg nog steeds hetzelfde
N280 11=0 R12=685.08 R13=450 R14=0 R15=0 (B0 G54 Xnpv GROTE BORING Y VERZAMELVLAK )
N290 21=0 R22=685.08 R23=455 R24=0 R25=0 (B90 G55 Xnpv MIDDEN Y VERZAMELVLAK )
N300 31=0 R32=685.08 R33=455 R34=0 R35=0 (B180 G56 Xnpv GROTE BORING Y VERZAMELVLAK)
Wat doe ik hier verkeerd, kan ik je eventueel de file doorsturen?
 
jantje1,

Ik denk dat ik het gevonden heb.
Test deze macro.
Code: 
Sub ToevoegenGetal()
'
' Macro1 Macro
' De macro is opgenomen op 19/03/2011 door Jan.
'
' Sneltoets: CTRL+h
Dim r, z
Dim rng As Range, cel As Range
Dim waarde As String, nieuwwaarde As String
Dim rest As String
Dim teller As Long
teller = 0
Set rng = Sheets("blad2").Range("A1", Sheets("blad2").Range("A65536").End(xlUp))
For Each cel In rng
waarde = cel
If Left(waarde, 1) <> ":" Then

teller = teller + 10
z = 1
r = InStr(z, waarde, " ")
'rest = Mid(waarde, r, Len(waarde))
rest = Right(waarde, Len(waarde) - r)
nieuwwaarde = "N" & teller & " " & rest

cel.Offset(0, 9) = nieuwwaarde
Else

z = 1
r = InStr(z, waarde, " ")
rest = Mid(waarde, r, Len(waarde))
nieuwwaarde = Left(waarde, r) & " " & rest

cel.Offset(0, 9) = nieuwwaarde
End If

Next

Columns("A:I").Select
Selection.Delete Shift:=xlToLeft
End Sub
 
Laatst bewerkt:
Het werkt perfect, nu nog een vraagske als er nu MSG staat is het dan mogelijk van deze rij niet te nummeren en dan voor de rest gewoon verder te gaan met nummeren.
Vb:
MSG H72099910 ;opgenomen vermogen"
MSG (VOLGEN)
N145 G59 Z40
N150 G0 G54 X-647 Y102 Z100 W-40 T1107
N155 Z-64 M8 M57 M63
N160 G1 X-647 Y-102
 
jantje1,

Ik ben maar een amateur en heb het zo voor je opgelost.
Ik hoor /zie het antwoord wel.

Code: 
Sub ToevoegenGetal()
'
' Macro1 Macro
' De macro is opgenomen op 19/03/2011 door Jan.
'
' Sneltoets: CTRL+h
Dim r, z
Dim rng As Range, cel As Range
Dim waarde As String, nieuwwaarde As String
Dim rest As String
Dim teller As Long
teller = 0
Set rng = Sheets("blad2").Range("A1", Sheets("blad2").Range("A65536").End(xlUp))
For Each cel In rng
waarde = cel
If Left(waarde, 1) <> ":" Then
If Left(waarde, 3) = "MSG" Then GoTo 1
teller = teller + 10
z = 1
r = InStr(z, waarde, " ")
'rest = Mid(waarde, r, Len(waarde))
rest = Right(waarde, Len(waarde) - r)
nieuwwaarde = "N" & teller & " " & rest

cel.Offset(0, 9) = nieuwwaarde
Else
1
cel.Offset(0, 9) = waarde
GoTo 2
'z = 1
'r = InStr(z, waarde, " ")
'rest = Mid(waarde, r, Len(waarde))
'nieuwwaarde = Left(waarde, r) & " " & rest

cel.Offset(0, 9) = nieuwwaarde
End If
2
Next

Columns("A:I").Select
Selection.Delete Shift:=xlToLeft
End Sub
 
Als ik dit nu uitvoert laat hij de Msg weg en zet hier gewoon een nummering in de plaats
 
Oeps, heb te snel geantwoord, want het werkt perfect zoals ik heb gewild, had Msg gezet ipv MSG.
Bedankt voor de oplossing.
 
Mag ik misschien nog vragen hoe je dit geleerd hebt en aan de hand met welke boeken ?
Mvg Jan
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan