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

Kleuren kopieren naar een andere cel (VBA)

Status
Niet open voor verdere reacties.
D

Dafje1986

Gebruiker
Lid geworden
20 mei 2008
Berichten
46
Onlangs had ik een code dat als je een cel een kleur gaf (in kolom A)
en vervolgens er iets in typte, dat deze dan in de rechtsliggende cel deze kleur ook neerzette (alleen de kleur).

Hier was ik samen met een leraar uitgekomen, alleen die code heb ik niet meer en de beste man is op vakantie :D

Kunnen jullie een voorzetje maken, dan kom ik erna zelf wel uit, maar zo een code schrijven ben ik nog niet goed genoeg voor...

Bij voorbaat dank!
 
Zoiets?

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    With Target
    
        If .Cells.Count = 1 Then
        
            If .Column < Columns.Count Then .Offset(0, 1).Interior.ColorIndex = .Interior.ColorIndex
        
        End If
        
    End With

End Sub

Wigi
 
Ja dankjewel, zo had ik het ook ongeveer.

Nou nog, dat hij het alleen in kolom D doet (van D naar E) en bij de rest niet.
En ditzelfde voor kolom K en dan gespiegeld.

Maar daar hoop ik zelf wel uit te komen, en anders meld ik me weer.
 
Ok kom er niet helemaal uit :D
ik heb het nu zo dat hij 7 cellen doet elke keer 1 omlaag en 1 naar rechts.

maar dit moet hij alleen doen als je in kolom D iets invult. en niet in elke cel!

please help!
 
Zo iets:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Count = 1 Then
    If Target.Column < Columns.Count Then Target.Offset(0, 1).Interior.ColorIndex = Target.Interior.ColorIndex
End If

End Sub

Met vriendelijke groet,


Roncancio
 
perfect, ik zat te klooien met columns("D") en zo, had er niet aan gedacht dat het met 4 kan...
 
Nou het laatste deel en dan ben ik klaar :thumb:

Nou heb ik bijgesloten de voorbeeld planning daar zit nu de code in dat hij vanuit kolom E de stappen inplant als je een kleur toekent en er dan iets in typt. Dit ook vanuit kolom AC.

Echter nou is het zo dat hij dus de "zondag" de balk er tussen in moet overslaan dus eentje naar beneden schuift.

Dus iets in de trend van als die cel dit is dan een naar beneden met die offset. Maar ik heb geen idee hoe ik dat moet doen...

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 And Target.Count = 1 Then
    If Target.Column < Columns.Count Then Target.Offset(0, 1).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(1, 2).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(2, 3).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(3, 4).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(4, 5).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(5, 6).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(6, 7).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(7, 8).Interior.ColorIndex = Target.Interior.ColorIndex
End If

If Target.Column = 29 And Target.Count = 1 Then
    If Target.Column < Columns.Count Then Target.Offset(0, -1).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(1, -2).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(2, -3).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(3, -4).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(4, -5).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(5, -6).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(6, -7).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(7, -8).Interior.ColorIndex = Target.Interior.ColorIndex
    If Target.Column < Columns.Count Then Target.Offset(8, -9).Interior.ColorIndex = Target.Interior.ColorIndex
End If

End Sub
 

Bijlagen

Laatst bewerkt:
Je zou het als volgt kunnen doen:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iKol As Integer
    If Target.Column = 5 And Target.Count = 1 Then
        For iKol = 1 To 8
            If Left(Target.Cells(1, Target.Column + iKol), 2) > "wk" Then
                Target.Offset(iKol, iKol).Interior.ColorIndex = Target.Interior.ColorIndex
            End If
        Next
    ElseIf Target.Column = 29 And Target.Count = 1 Then
        For iKol = 1 To 8
            If Left(Target.Cells(1, Target.Column + iKol), 2) > "wk" Then
                Target.Offset(iKol, -iKol).Interior.ColorIndex = Target.Interior.ColorIndex
            End If
        Next
    End If

End Sub

Met vriendelijke groet,


Roncancio
 
Nou gebeurt er helemaal niks... ligt dit aan mij? heb de code gewoon geplakt op de plek van de oude code...
 
Dafje1986 zei:
Nou gebeurt er helemaal niks... ligt dit aan mij? heb de code gewoon geplakt op de plek van de oude code...
Klik om te vergroten...

De vorige versie was de verkeerde.
Deze werkt wel.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iKol As Integer
    If Target.Column = 5 And Target.Count = 1 Then
        For iKol = 1 To 8
            If Left(Target.Cells(Target.Row, "A"), 2) <> "wk" Then
                Target.Offset(iKol, iKol).Interior.ColorIndex = Target.Interior.ColorIndex
            End If
        Next
    ElseIf Target.Column = 29 And Target.Count = 1 Then
        For iKol = 1 To 8
            If Left(Target.Cells(Target.Row, "A"), 2) <> "wk" Then
                Target.Offset(iKol, -iKol).Interior.ColorIndex = Target.Interior.ColorIndex
            End If
        Next
    End If

End Sub

Met vriendelijke groet,


Roncancio
 
Nee hij verspringt niet bij mij... hij gaat gewoon door de balk heen zeg maar.
Maar als ik de code goed begrijp dan geef je wel aan dat als er wk staat dat hij 2 moet verspringen ipv 1 maar daarna staat toch gewoon ikol dus dan pakt hij ook maar 1 cel...

iig al bedankt voor je vele moeite...
 
Zo dan?
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iKol As Integer
    If Target.Column = 5 And Target.Count = 1 Then
        For iKol = 1 To 8
            If Left(Cells(Target.Row + iKol, "A"), 2) <> "wk" Then
                Target.Offset(iKol, iKol).Interior.ColorIndex = Target.Interior.ColorIndex
            End If
        Next
    ElseIf Target.Column = 29 And Target.Count = 1 Then
        For iKol = 1 To 8
            If Left(Cells(Target.Row + iKol, "A"), 2) <> "wk" Then
                Target.Offset(iKol, -iKol).Interior.ColorIndex = Target.Interior.ColorIndex
            End If
        Next
    End If

End Sub

Met vriendelijke groet,


Roncancio
 
Het begint er op te lijken, nou is alleen het geval dat hij dan idd die zondag wit laat, maar die dag word er niet gewerkt dus moeten ze op maandag dus maar 1 stap verder beginnen ipv 2.

en als ik je het niet te lastig maak dan moet de eerste cel op dezelfde hoogte zijn en dan de rest wel 1 naar onder en naar rechts (of links in het andere geval) (zie afbeelding)


Sorry dat ik zo veel vraag, maar ik snap de code nou niet meer zo goed dus kom er zelf niet meer uit.

Bedankt!
 

Bijlagen

  • excel.JPG
    excel.JPG
    74,7 KB · Weergaven: 74
Deze code is aangepast aan het JPG-bestand.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iKol As Integer
Dim iTel As Integer
Dim iNorm As Integer
    iKol = 1
    iNorm = 9
    While iTel <= iNorm
        If Target.Column = 5 And Target.Count = 1 Then
            If Left(Cells(Target.Row + iTel, "A"), 2) <> "wk" Then
                Target.Offset(iTel, iKol).Interior.ColorIndex = Target.Interior.ColorIndex
            Else
                iKol = iKol - 1
            End If
        ElseIf Target.Column = 29 And Target.Count = 1 Then
            iNorm = 10
            If Left(Cells(Target.Row + iTel, "A"), 2) <> "wk" Then
                Target.Offset(iTel, -iKol).Interior.ColorIndex = Target.Interior.ColorIndex
            Else
                iKol = iKol - 1
            End If
        End If
        iTel = iTel + 1
        iKol = iKol + 1
    Wend
End Sub

Met vriendelijke groet,


Roncancio
 
Perfect!

heel erg bedankt voor je tijd en moeite

bedankt voor het bijdrage aan een goed punt voor me stage (hopelijk)
en een bedrijf die er beter door functioneerd! :D
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan