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

afronden van getallen

Status
Niet open voor verdere reacties.
W

westra77

Gebruiker
Lid geworden
2 mrt 2007
Berichten
149
dmv van dit forum
heb ik volgende macro opgenomen
Code: 
Sub fff()
Dim c As Range
    
    For Each c In Range("d6:d10")
        With c
            If Len(Range("B" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Range("A" & .Row).Value & "(" & Range("B" & .Row).Value & ")"
                .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Bold = True
                .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Size = 8
            End If
        End With
    Next c

End Sub
deze werkt goed en geeft een verschillende opmaak in in cel weer
echter de getallen worden niet afgerond (zie bestand)
volgens mij moet er ergens
Code: 
numberformatt ="0"
toegevoegd worden
dit lukt mij echter niet
heeft iemand een oplossing
 

Bijlagen

westra77 zei:
dmv van dit forum
heb ik volgende macro opgenomen
Code: 
Sub fff()
Dim c As Range
    
    For Each c In Range("d6:d10")
        With c
            If Len(Range("B" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Range("A" & .Row).Value & "(" & Range("B" & .Row).Value & ")"
                .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Bold = True
                .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Size = 8
            End If
        End With
    Next c

End Sub
deze werkt goed en geeft een verschillende opmaak in in cel weer
echter de getallen worden niet afgerond (zie bestand)
volgens mij moet er ergens
Code: 
numberformatt ="0"
toegevoegd worden
dit lukt mij echter niet
heeft iemand een oplossing
Klik om te vergroten...

Als je wilt afronden kan je beter ROUND gebruiken.
Deze rondt af en je kunt aangeven op hoeveel decimalen.

Met vriendelijke groet,


Roncancio
 
Laatst bewerkt:
Maak van:

Code: 
Range("A" & .Row).Value

dit

Code: 
Round(Range("A" & .Row).Value, 0)

En ook bij de 5 andere soortgelijke commando's. Anders afronden (bv. INT) mag uiteraard ook.

Wigi
 
Het is mij niet helemaal duidelijke welke waarde je wilt afronden. Maar dat kan aan mij liggen.:confused:

Code: 
Sub fff()
Dim c As Range
    
    For Each c In Range("d6:d10")
        With c
            If Len(Range("B" & .Row).Value) = 0 Then
                .ClearContents
            Else
[B]                .Value = Round(Range("A" & .Row).Value, 0) & "(" & Round(Range("B" & .Row).Value, 0) & ")"[/B]
                .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Bold = True
                .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Size = 8
            End If
        End With
    Next c

End Sub
In bovenstaande code worden de waardes in de A én B-kolom afgerond.

Indien de A-kolom moet worden afgerond: Verander de vetgedrukte regel in:
Code: 
                .Value = Round(Range("A" & .Row).Value, 0) & "(" & Range("B" & .Row).Value & ")"

Indien de B-kolom moet worden afgerond: Verander de vetgedrukte regel in:
Code: 
                .Value = Range("A" & .Row).Value & "(" & Round(Range("B" & .Row).Value, 0) & ")"

Met vriendelijke groet,


Roncancio
 
bedankt
onderstaande aanpassing werkt zeer goed


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

End Sub
beide getallen wilde ik afronden
vr gr
 
Laatst bewerkt:
Graag gedaan.

Gaarne de vraag op opgelost zetten.
Bvd.

Met vriendelijke groet,


Roncancio
 
hallo
ik krijg een foutmelding zodra ik een selectievakje inschakel op een ander werkblad
fout 13 typen komen niet met elkaar overeen


Code: 
Sub tussenhaakjes()
Dim c As Range
    
    For Each c In Range("x8:x27")
        With c
            If Len(Range("w" & .Row).Value) = 0 Then
                .ClearContents
         Else
             [COLOR="Red"] .Value = Round(Range("q" & .Row).Value, 0) & "(" & Round(Range("w" & .Row).Value, 0) & ")"  [/COLOR]             .Characters(Len(Round(Range("q" & .Row).Value, 0)) + 2, Len(Round(Range("w" & .Row).Value, 0))).Font.Bold = True
                         .Characters(Len(Round(Range("q" & .Row).Value, 0)) + 2, Len(Round(Range("w" & .Row).Value, 0))).Font.Size = 8
            
            End If
        End With
    Next c

Dim d As Range
    
    For Each d In Range("y8:y27")
        With d
            If Len(Range("e" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Range("r" & .Row).Value, 0) & "(" & Round(Range("e" & .Row).Value, 0) & ")"
                .Characters(Len(Round(Range("r" & .Row).Value, 0)) + 2, Len(Round(Range("e" & .Row).Value, 0))).Font.Bold = True
                .Characters(Len(Round(Range("r" & .Row).Value, 0)) + 2, Len(Round(Range("e" & .Row).Value, 0))).Font.Size = 8
            End If
        End With
    Next d


End Sub
zodra ik het selectievakje aanklik (inschakel) werkt de code wel juist
enig idee wat ik hier aan kan doen?
alvast bedankt
 
Laatst bewerkt:
Staat er tekst in de Q en/of W-kolom van het andere werkblad? De macro controleert in het actieve werkblad. Wil je dat er steeds in hetzelfde werkblad wordt gecontroleerd, dan zul je die werkblad moeten specificeren. Bijv.:
Code: 
WorkSheet("Blad1").Range(

ipv

Code: 
Range(

Met vriendelijke groet,


Roncancio
 
er staat inderdaad tekst op blad1 in de kolommen x en y
bovenstaande oplossing proberen door te voeren, maar krijg steeds een compileerfout
wat doe ik fout?
ps ook WorkSheet("Blad1").Range(
werkte niet


Code: 
Sub tussenhaakjes()
Dim c As Range
    
    For Each c In Sheets("blad2").Range("x8:x27")
        With c
            If Len(Sheets("blad2").Range("w" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("blad2").Range("q" & .Row).Value, 0) & "(" & Round(Sheets("blad2").Range("w" & .Row).Value, 0) & ")"
                .Characters(Len(Sheets("blad2").Range(Range("q" & .Row).Value, 0)) + 2, Len(Round(Sheets("blad2").Range("w" & .Row).Value, 0))).Font.Bold = True
                .Characters(Len(Sheets("blad2").Range(Range("q" & .Row).Value, 0)) + 2, Len(Round(Sheets("blad2").Range("w" & .Row).Value, 0))).Font.Size = 8
            
            End If
        End With
    Next c
 
Laatst bewerkt:
Met onderstaande code werkt het bij mij wel.

Code: 
Sub tussenhaakjes()
Dim c As Range
    
    For Each c In Sheets("blad2").Range("x8:x27")
        With c
            If Len(Sheets("blad2").Range("w" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Round(Sheets("blad2").Range("q" & .Row).Value, 0) & "(" & Round(Sheets("blad2").Range("w" & .Row).Value, 0) & ")"
                .Characters(Len(Sheets("blad2").Range("q" & .Row).Value) + 2, Len(Round(Sheets("blad2").Range("w" & .Row).Value, 0))).Font.Bold = True
                .Characters(Len(Sheets("blad2").Range("q" & .Row).Value) + 2, Len(Round(Sheets("blad2").Range("w" & .Row).Value, 0))).Font.Size = 8
            
            End If
        End With
    Next c
End Sub

De waardes in de W-kolom worden vet en tussenhaakjes weergegeven en bovendien met lettergrootte 8.
P.s. WorkSheet("Blad1").Range( diende als voorbeeld voor een gedeelte van de code niet als een totale regel.:rolleyes::)

Met vriendelijke groet,


Roncancio
 
Laatst bewerkt:
ik heb jou code overgenomen, deze geeft bij mij onderstaande fout
fout 9 tijdens uitvoering het subscript val buiten het bereik
 
Waar krijg je precies de foutmelding?
Voor de zekerheid stuur ik je het bestand.
De code is het bestand is identiek aan de code waar jij de foutmelding mee kreeg.

Met vriendelijke groet,


Roncancio
 

Bijlagen

de foutmelding is opgelost (er zat een fout in een formule)
ik blijf echter een vreemd probleem houden
de macro werkt goed, behalve als ik het selectievakje aanvink op blad 1 bij afwijking
zonder een vinkje geeft hij op blad twee de gewenste oplossing, maar zodra ik een vinkje plaats werkt de macro niet meer??
zie vb bestand
 

Bijlagen

westra77 zei:
de foutmelding is opgelost (er zat een fout in een formule)
ik blijf echter een vreemd probleem houden
de macro werkt goed, behalve als ik het selectievakje aanvink op blad 1 bij afwijking
zonder een vinkje geeft hij op blad twee de gewenste oplossing, maar zodra ik een vinkje plaats werkt de macro niet meer??
zie vb bestand
Klik om te vergroten...

Geef eens duidelijk aan wat je doet, want ik kan het probleem niet reproduceren.
 
Door het aanvinken van een selectievakje wijzigen de waardes op het 2e werkblad, maar zijn de bedragen niet afgerond.
Vandaar dat de code niet goed werkt.

Met vriendelijke groet,


Roncancio
 

Bijlagen

ik kan het vb bestand niet openen
ik ontvang de volgende foutmelding
de gecomprineerde map is ongeldig of beschadigd
 
Westra, open zip-file met Winrar en selecteer betreffende bestand. Daarna Alt-V en bestand wordt zichtbaar. Tegenwoordig veelvuldig voorkomende fout op het forum. Reden ?

Mvg

Rudi
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan