• 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.

macro werkt niet juist

Status
Niet open voor verdere reacties.

westra77

Gebruiker
Lid geworden
2 mrt 2007
Berichten
149
in navolging op eerder door mij gestarte topics, heb ik enkele codes achter elkaar geplaatst.
graag wil ik dat de macro eerst sorteert, daarna kijkt of in cel b12 een 0 of 1 staat (deze is gekoppeld aan een selectievakje)
daarna plaatst hij de juiste cellen naar b15:b19
ik krijg een foutmelding
wie kan mij verder helpen
alvast bedankt

Code:
Sub Macro4()
'
' Macro4 Macro
' De macro is opgenomen op 26-8-2008 door jwestra.
'

'
Sheets("blad1").Select
Range("b6:c10").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


If Sheets("blad1").Range("b12").Value = 0 Then
                
        Sheets("blad1").Range("b6:b10").Copy Sheets("blad1").Range("b15:b19")
        
    Else

Dim c As Range
    
    For Each c In Sheets("blad1").Range("b15:b19")
        With c
            If Len(Sheets("blad1").Range("b" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("blad1").Range("c" & .Row).Value, 0) & "(" & Round(Sheets("blad1").Range("b" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Sheets("blad1").Range("c" & .Row).Value, 0)) + 2, Len(Round(Sheets("blad1").Range("b" & .Row).Value, 0))).Font.Bold = True
                .Characters(Len(Round(Sheets("blad1").Range("c" & .Row).Value, 0)) + 2, Len(Round(Sheets("blad1").Range("b" & .Row).Value, 0))).Font.Size = 8
            
    End If
        End With
    Next c


    End If

Sheets("blad1").Protect ("joppe")

End Sub
 

Bijlagen

Dat komt omdat de bladbeveiliging nog aan staat.
Als je de beveiliging eraf haalt, werkt het wel.

Code:
Sheets("blad1").Range("b6:c10").Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Gelieve geen .Select te gebruiken.
Bovenstaande code werkt ook voor de sortering.

Met vriendelijke groet,


Roncancio
 
de volgende code er van gemaakt, blijft echter nog steeds een foutmelding
"fout 13: typen komen niet met elkaar overeen" houden
Code:
Sub Macro4()
'
' Macro4 Macro
' De macro is opgenomen op 26-8-2008 door jwestra.
'

'
Sheets("Blad1").Unprotect ("joppe")

Sheets("Blad1").Range("b6:c10").Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


If Sheets("Blad1").Range("b12").Value = 0 Then
                
        Sheets("Blad1").Range("b6:b10").Copy Sheets("Blad1").Range("b15:b19")
        
    Else

Dim c As Range
    
    For Each c In Sheets("Blad1").Range("b15:b19")
        With c
            If Len(Sheets("Blad1").Range("b" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("Blad1").Range("c" & .Row).Value, 0) & "(" & Round(Sheets("Blad1").Range("b" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Sheets("Blad1").Range("c" & .Row).Value, 0)) + 2, Len(Round(Sheets("Blad1").Range("b" & .Row).Value, 0))).Font.Bold = True
                .Characters(Len(Round(Sheets("Blad1").Range("c" & .Row).Value, 0)) + 2, Len(Round(Sheets("Blad1").Range("b" & .Row).Value, 0))).Font.Size = 8
            
    End If
        End With
    Next c


    End If

Sheets("Blad1").Protect ("joppe")

End Sub
 
Dan ben ik benieuwd waar je de foutmelding krijg want bij mij werkt het als een zonnetje.:cool:
Voor de zekerheid heb ik de nieuwe versie erbij gedaan.

Met vriendelijke groet,


Roncancio
 

Bijlagen

Beste Roncancio ;)

Als je cel B12 veranderd in 1 en de codeuitvoert geeft hij foutmelding.
Dit in versie Excel 2007.

De foutmelding is de volgende

Code:
.Characters(Len(Round(Sheets("Blad1").Range("c" & .Row).Value, 0)) + 2, Len(Round(Sheets("Blad1").Range("b" & .Row).Value, 0))).Font.Bold = True

Groetjes Danny. :thumb:
 
Als je cel B12 veranderd in 1 en de codeuitvoert geeft hij foutmelding.
Dit in versie Excel 2007.
Bij Excel 2003 ging toch niet helemaal zoals het zou moeten.:o:o
Bedankt Danny voor je reactie.:thumb:

Ik heb de macro aangepast en ook wat leesbaarder gemaakt.

Met vriendelijke groet,


Roncancio
 

Bijlagen

beste Roncancio en danny

in cel b15:b19 geeft hij als resultaat 0 of indien b12=1 dan 0(0)
waarom worden de waarden uit range b6:b10 niet weergegeven, of waarom worden er geen waarden weergegeven wanneer b12 =1. bv 3(6)??:confused:
 
beste Roncancio en danny

in cel b15:b19 geeft hij als resultaat 0 of indien b12=1 dan 0(0)
waarom worden de waarden uit range b6:b10 niet weergegeven, of waarom worden er geen waarden weergegeven wanneer b12 =1. bv 3(6)??:confused:

Omdat er verwezen wordt naar de cellen B15 t/m B19 van Blad2.

Met vriendelijke groet,


Roncancio
 
mijn kennis blijft beperkt in vba
Ik dacht/denk dat onderstaande code juist zorgde voor een verwijzing naar blad1
hoe kan ik dit aanpassen?


Code:
If Sheets("Blad1").Range("b12").Value = 0 Then
                
        Sheets("Blad1").Range("b6:b10").Copy Sheets("Blad1").Range("b15:b19")
        
    Else
 
mijn kennis blijft beperkt in vba
Ik dacht/denk dat onderstaande code juist zorgde voor een verwijzing naar blad1
hoe kan ik dit aanpassen?


Code:
If Sheets("Blad1").Range("b12").Value = 0 Then
                
        Sheets("Blad1").Range("b6:b10").Copy Sheets("Blad1").Range("b15:b19")
        
    Else

Ik heb de code aangepast omdat er wel gekopieerd werd maar de telling van de regels liep door. Maw er werd naar de verkeerde cellen verwezen.

Met vriendelijke groet,


Roncancio
 

Bijlagen

Hallo Roncancio

excuus dat ik er zelf niet meer uit kan komen, maar blijf nog twee fouten houden
in cel b15:b19 zouden de volgende uitkomsten moeten komen bv: 3(6), waarbij 3 verwijst naar c6 en 6 verwijst naar b6. In jou laaste vb is de uitkomst 0(6).
daarnaast krijg ik bij het invoeren van een 1 in cel b12 de eerste keer geen foutmelding.
laat ik de macro daarna opnieuw uitvoeren, dan krijg ik een foutmelding
Code:
  .Value = Round(Sheets("Blad1").Range("c" & .Row).Value, 0) & "(" & Round(Sheets("Blad1").Range("b" & .Row).Value, 0) & ")"
alvast bedankt.
 
Hallo Roncancio

excuus dat ik er zelf niet meer uit kan komen, maar blijf nog twee fouten houden
in cel b15:b19 zouden de volgende uitkomsten moeten komen bv: 3(6), waarbij 3 verwijst naar c6 en 6 verwijst naar b6. In jou laaste vb is de uitkomst 0(6).
daarnaast krijg ik bij het invoeren van een 1 in cel b12 de eerste keer geen foutmelding.
laat ik de macro daarna opnieuw uitvoeren, dan krijg ik een foutmelding
Code:
  .Value = Round(Sheets("Blad1").Range("c" & .Row).Value, 0) & "(" & Round(Sheets("Blad1").Range("b" & .Row).Value, 0) & ")"
alvast bedankt.

De fout van de verwijzing heb ik aan kunnen passen maar de andere fout (1e keer goed, 2e keer foutmelding) wordt lastiger omdat je volgens de code het getal wil in de B-kolom wilt afronden en dat wordt lastig omdat het geen getal meer is door de haakjes.
Excel herkent het niet meer als een getal.

Met vriendelijke groet,


Roncancio
 

Bijlagen

met een hulp kolom werkt hij volgens mij wel
ik heb kolom d als hulpkolom gebruikt


Code:
Sub Macro4()
'
' Macro4 Macro
' De macro is opgenomen op 26-8-2008 door jwestra.
'

'
Sheets("Blad1").Unprotect ("joppe")

Sheets("Blad1").Range("a6:c10").Sort Key1:=Range("a6"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal



Dim c As Range
    
    For Each c In Sheets("blad1").Range("d6:d10")
        With c
            If Len(Sheets("blad1").Range("c" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("blad1").Range("b" & .Row).Value, 0) & "(" & Round(Sheets("blad1").Range("c" & .Row).Value, 0) & ")"
                .Characters(Len(Sheets("blad1").Range("b" & .Row).Value) + 2, Len(Round(Sheets("blad1").Range("c" & .Row).Value, 0))).Font.Bold = True
                .Characters(Len(Sheets("blad1").Range("b" & .Row).Value) + 2, Len(Round(Sheets("blad1").Range("c" & .Row).Value, 0))).Font.Size = 8
            
            End If
        End With
    Next c




        
    If Range("b12").Value = 0 Then
                
        Sheets("Blad1").Range("b6:b10").Copy
        Sheets("Blad1").Range("b15:b19").PasteSpecial Paste:=xlPasteValues

        
    Else
    
        Sheets("Blad1").Range("d6:d10").Copy Sheets("Blad1").Range("b15:b19")
    
    End If
            
   

Sheets("Blad1").Protect ("joppe")

End Sub
 
Welke waardes moeten er worden weergeven als B12 0 is?
Wellicht heb je dan geen hulpkolom nodig. Tenzij je het zo wilt.

Met vriendelijke groet,


Roncancio
 
het verschil is dat de macro niet meer vastloopt indien er voor de tweede keer op de macro knop wordt gedrukt. de resultaten blijven gelijk aan het door jou ontwikkelde vb.
 
het verschil is dat de macro niet meer vastloopt indien er voor de tweede keer op de macro knop wordt gedrukt. de resultaten blijven gelijk aan het door jou ontwikkelde vb.

Lijkt mij goed, toch?:)
Of mis ik iets?:confused:

Met vriendelijke groet,


Roncancio
 
hallo
mischien een beetje verwarrend, in mijn aangepaste versie loopt de macro niet meer vast, in jou laatste versie wel. (bij tweede gebruik van de macro)
dus in principe is het probleem opgelost, maar wel met hulpkolom.
ik heb geen oplossing om het zonder hulpkolom te kunnen doen en tevens dat de macro niet meer vastloopt.
hoop dat het zo duidelijk is
 
hallo
mischien een beetje verwarrend, in mijn aangepaste versie loopt de macro niet meer vast, in jou laatste versie wel. (bij tweede gebruik van de macro)
dus in principe is het probleem opgelost, maar wel met hulpkolom.
ik heb geen oplossing om het zonder hulpkolom te kunnen doen en tevens dat de macro niet meer vastloopt.
hoop dat het zo duidelijk is

T'is maandagmorgen, hé?:confused:
Ik heb het bestand aangepast en ik krijg geen foutmeldingen meer.
Bovendien komen de waardes overeen met je bestand.

Met vriendelijke groet,


Roncancio
 

Bijlagen

Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan