VBA: Benachbarte Zellen automatisch füllen, wenn...

[murphie_g]

Hallo zusammen,

ich habe eine Excel-Tabelle und folgendes Problem (anbei die Excel-Datei).

Auf dem Tabellenblatt "Objekte" hätte ich gerne, dass Excel mir die "x"-e automatisch für die Gesellschafter (hier Kürzel: JPS, JPJ, SPP, ...) setzt, wenn die gleiche Gesellschaft schon mal in einer Zeile drüber eingetragen worden ist.

Kennt sich hier jemand aus und kann mir helfen?

Danke im Voraus :)

[atilla]

Hallo,

teste mal:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
   If Target.Column = 2 And Target.Row > 8 Then
      If Target <> "" Then
         If Application.CountIf(Range("B8:B" & Target.Row - 1), Target.Value) Then
            Range(Cells(Target.Row, 3), Cells(Target.Row, 8)) = "x"
         End If
      Else
         Range(Cells(Target.Row, 3), Cells(Target.Row, 8)) = ""
      End If
   End If
End If
End Sub

[murphie_g]

Danke, aber klappt bei mir irgendwie nicht. Hast du es mal eingegeben und es hat geklappt? Hab die Datei mit angefügt.

[atilla]

Hallo,

ja, das habe ich und es hat geklappt.

Du fügst den Code in das Code Fenster der Tabelle "Objekte".

Sobald Du in Spalte B etwas einträgst, wird geprüft ob der gleiche Wert in den darüber liegenden Zeilen vorkommt.
Wenn Ja, werden die Nachbarzellen entsprechend mit x gefüllt.

Wenn Du den Wert löschst, dann werden auch die x' en wieder gelöscht.

[murphie_g]

Kannst du mir bitte die Datei schicken, kenn mich mit VBA gar nicht aus. Vielleicht mach ich da was falsch.

Danke im Voraus.

[atilla]

Hallo,

du brauchst Dich nicht auskennen.
Das bekommst Du mit Einweisung hin.

Mach ein Rechts Klick auf den Tabellenreiter der Tabelle "Objekte"
Es erscheint ein Kontextmenü.
Dort, etwa in der Mitte, "Code anzeigen" wählen.

Es erscheint das Codefenster der Tabelle.
Rechts in das Fenster fügst Du den unten stehenden Code ein.

Das war es. teste jetzt mit Eingaben in Spalte B.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
   If Target.Column = 2 And Target.Row > 9 Then
      If Target <> "" Then
         If Application.CountIf(Range("B9:B" & Target.Row - 1), Target.Value) Then
            Range(Cells(Target.Row, 3), Cells(Target.Row, 8)) = "x"
         End If
      Else
         Range(Cells(Target.Row, 3), Cells(Target.Row, 8)) = ""
      End If
   End If
End If
End Sub

Macht zwar nichts aus, aber hier beginnt die Prüfung ab Zeile 9 und nicht wie vorhin ab Zeile 8.

[murphie_g]

Habe es jetzt doch hinbekommen, doch füllt er die gesamte Zeile mit x und nicht so wie es in einer vorherigen Zeile für die Gesellschaft gemacht worden ist. Ist das bei dir auch so?

---

Ich hab mal ein Bildschirmfoto gemacht. Er füllt einfach die ganze Zeile mit den x und nicht wie schonmal für die Gesellschaft in eine vorherigen Zeile. Habe ich was falsch gemacht? Bzw. kannst du mir da helfen?

Danke vorab für deine bisherige Hilfe :)

---

hier das Bild

[atilla]

Hallo,

ja, so habe ich es programmiert.
Habe wohl zu einfach gedacht.

Gleich stelle ich dann eine Korrektur ein.

[murphie_g]

Danke :)

[atilla]

Hallo,

sind ein paar Zeilen Code hinzugekommen, aber schau mal, ob es jetzt Deinen Wünschen entspricht:

Code:

   Dim i As Long
   Dim vantX
   If Target.Count = 1 Then
      If Target.Column = 2 And Target.Row > 9 Then
         If Target <> "" Then
            vantX = Application.Match(Target.Value, Range("B9:B" & Target.Row - 1), 0)
            If IsNumeric(vantX) Then
               Range(Cells(Target.Row, 3), Cells(Target.Row, 8)) = ""
               For i = 1 To 6
                  If Cells(vantX + 8, i + 2) = "x" Then Target.Offset(0, i) = "x"
               Next i
            End If
         Else
            Range(Cells(Target.Row, 3), Cells(Target.Row, 8)) = ""
         End If
      End If
   End If