Cellen automatisch invullen via een code

[zanfa11]

Beste

Als ik de letter "X" in cel (A1) typ zou ik graag hebben dat in cel (C1) (D1) (E1) (G1) (H1) (J1) het woord "oké" automatisch (via een macro) verschijnt, en als ik de letter "Z" in cel A2 typ dan zou het woord "NOK" mogen verschijnen in cel (F1) (I1) (K1).

Graag hulp

Alvast bedankt

 

[OctaFish]

Kan je toch ook gewoon met formules doen?

 

[zanfa11]

Hallo

Bedankt voor uw snelle reactie. Het klopt dat het met formules ook gaat, maar ik zou ook graag de mogelijkheid willen hebben om in die cellen (soms) iets anders in te vullen.

Mvg

 

[HSV]

In moduleblad van toepassing.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tb As Range
If Target.Column = 1 And Target.Count = 1 Then
Application.EnableEvents = False
     With Target
      Select Case .Value
        Case "x", "X"
          Set tb = Union(.Offset(, 2).Resize(, 3), .Offset(, 6).Resize(, 2), .Offset(, 9))
          tb = "oke"
        Case "z", "Z"
          Set tb = Union(.Offset(, 5), .Offset(, 8), .Offset(, 10))
          tb = "nok"
      End Select
    End With
 Else
   Target.Resize(, 12).ClearContents
 End If
Application.EnableEvents = True
End Sub

 

[zanfa11]

Beste

Bedankt.

Als ik de letter "z" ingeef dan verdwijnt het bestand.

mvg

 

[HSV]

Hier heb je wat secondelijm.

 

[zanfa11]

Beste HSV

Als ik "z" in CEL B1 ingeef verdwijnt het bestand.

Mvg

Zanfa

 

[HSV]

Bij mij verdwijnen wel de gegevens op die rij, maar het bestand blijft hier mooi in beeld.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tb As Range
Application.EnableEvents = False
If Target.Column = 1 And Target.Count = 1 Then
If Target > 0 Then
     With Target
      Select Case .Value
        Case "x", "X"
          Set tb = Union(.Offset(, 2).Resize(, 3), .Offset(, 6).Resize(, 2), .Offset(, 9))
          tb = "oke"
        Case "z", "Z"
          Set tb = Union(.Offset(, 5), .Offset(, 8), .Offset(, 10))
          tb = "nok"
      End Select
    End With
 Else
   Target.Resize(, 12).ClearContents
  End If
 End If
Application.EnableEvents = True
End Sub

 

[zanfa11]

Beste

Nu is het veel beter. Alleen de X moet in A1 ingegeven worden en de Z in B1.

Alvast bedankt

 

[HSV]

En dat voor elke rij, of is dat niet nodig?

 

[zanfa11]

Als ik de letter "X" in cel (A1) typ zou ik graag hebben dat in cel (C1) (D1) (E1) (G1) (H1) (J1) het woord "oké" automatisch (via een macro) verschijnt, en als ik de letter "Z" in cel A2 typ dan zou het woord "NOK" mogen verschijnen in cel (F1) (I1) (K1).

 

[HSV]

Begrijp ik.
Alleen voor A1 en B1, of ook voor andere rijen in kolom 1 en 2?

 

[zanfa11]

Alleen voor A1 en AB

bedankt

 

[HSV]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tb As Range
If Not Intersect(Target, Range("a1:b1")) Is Nothing Then
Application.EnableEvents = False
With Target
 If Target.Count = 1 Then
  If .Column = 1 And LCase(.Value) = "x" Then
         .Offset(, 1).Resize(, 11).ClearContents
          Set tb = Union(.Offset(, 2).Resize(, 3), .Offset(, 6).Resize(, 2), .Offset(, 9))
          tb = "oke"
    ElseIf .Column = 2 And LCase(.Value) = "z" Then
          .Offset(, -1).ClearContents
          .Offset(, 1).Resize(, 10).ClearContents
          Set tb = Union(.Offset(, 4), .Offset(, 7), .Offset(, 9))
          tb = "nok"
     Else
    Cells(1).Resize(, 11).ClearContents
   End If
  End If
  End With
Application.EnableEvents = True
End If
End Sub

 

[zanfa11]

Beste

Hartelijk dank. Het werkt perfect. Het is precies wat ik wou. Nu heb ik mijn bestand aangepast en heb zelf geprobeerd om de code aan te passen maar zonder resultaat. Hieronder vindt u de veranderingen:

A1 en B1 worden vervangen door O9 en P9 .Dit is mij wel gelukt!!

'OKE' zou verschijnen in cellen : Q9; R9; S9; T9; U9; V9; W9; X9; Y9; Z9; AA9; AB9; AC9; AD9; AE9; AF9.

'NOK' zou verschijnen in cellen Q9; Z9; AC9; AD9; AG9.

Alvast bedankt

Zanfa

 

[HSV]

Dan moet je kijken, tellen en testen wat .offset(,1) doet vanaf target.
Daarna .offset(,3) enz.
Als je dat onder de knie hebt, speel je ermee.

 

[zanfa11]

Beste HSV

Ik denk dat ik het gevonden heb, maar ik kan de inhoud van cel AG9 niet wissen. Zie code:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim tb As Range
If Not Intersect(Target, Range("O99")) Is Nothing Then
Application.EnableEvents = False
With Target
If Target.Count = 1 Then
If .Column = 15 And LCase(.Value) = "x" Then
.Offset(, 1).Resize(, 11).ClearContents
Set tb = Union(.Offset(, 2).Resize(, 4), .Offset(, 6).Resize(, 11), .Offset(, 17))
tb = "oke"
ElseIf .Column = 16 And LCase(.Value) = "z" Then
.Offset(, -1).ClearContents
.Offset(, 1).Resize(, 17).ClearContents
Set tb = Union(.Offset(, 1), .Offset(, 10), .Offset(, 13), .Offset(, 14), .Offset(, 17))
tb = "nok"
Else
Cells(1).Resize(, 11).ClearContents
End If
End If
End With
Application.EnableEvents = True
End If
End Sub


Mvg

Zanfa

 

[HSV]

Zet het even in codetags, dan krijg je ook geen smiley's.
De code selecteren en op # klikken boven in het scherm bij geavanceerd.

 

[zanfa11]

Deze heb ik vandaag bijgeleerd; Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tb As Range
If Not Intersect(Target, Range("O9:P9")) Is Nothing Then
Application.EnableEvents = False
With Target
If Target.Count = 1 Then
If .Column = 15 And LCase(.Value) = "x" Then
.Offset(, 1).Resize(, 11).ClearContents
Set tb = Union(.Offset(, 2).Resize(, 4), .Offset(, 6).Resize(, 11), .Offset(, 17))
tb = "oke"
ElseIf .Column = 16 And LCase(.Value) = "z" Then
.Offset(, -1).ClearContents
.Offset(, 1).Resize(, 17).ClearContents
Set tb = Union(.Offset(, 1), .Offset(, 10), .Offset(, 13), .Offset(, 14), .Offset(, 17))
tb = "nok"
Else
Cells(1).Resize(, 11).ClearContents
End If
End If
End With
Application.EnableEvents = True
End If
End Sub

 

[HSV]

In dit stukje ...

.Offset(, 1).Resize(, 11).ClearContents

.....worden de cellen één rechts van target en de volgende 10 naar rechts geledigd.
Inclusief target is dit 11.

Dus vanaf cel P1 worden de 11 cellen rechts ervan leeggemaakt.