celopmaak behouden

[westra77]

in navolging op het topic afronden van getallen
nog een laatste uitbreiding
het is gelukt om de verschillende opmaak te verkrijgen in 1 cel (met behulp van dit forum)
in de kolommen E6:E10 zou ik afhankelijk van de invoer in a12 (1 of 0)
de waarde van kolom d of b krijgen.
kan ik de opmaak ook behouden zoals die in d of b wordt weergegeven
zia vb bestand

 

[Wigi]

Je kan toch een copy methode gebruiken? Dan wordt de opmaak behouden.

Zet een IF-THEN-ELSE structuur om te kijken of A12 0 is of niet.

Ofwel kopieer je B6:B10, ofwel D6: D10.

Wigi

 

[westra77]

je hebt gelijk, dat had ik zelf kunnen bedenken
toch bedankt voor de voorzet

 

[Wigi]

Inderdaad.

Dit is al voldoende:

    If Range("A12").Value = 0 Then
                
        Sheets("blad1").Range("b6:b10").Copy Sheets("blad1").Range("e6:e10")
        
    Else
    
        Sheets("blad1").Range("d6:d10").Copy Sheets("blad1").Range("e6:e10")
    
    End If

Door Copy te gebruiken vermijd je het programmeren van .Characters en zo, zoals in het eerste stuk van de code.

Wigi

 

[westra77]

dit is nog iets korter

Sub tussenhaakjes2()

If Range("A12").Value = 0 Then
                
        Sheets("blad1").Range("b6:b10").Copy Sheets("blad1").Range("d6:d10")
        
    Else


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


    End If
End Sub