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 :)
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
Danke, aber klappt bei mir irgendwie nicht. Hast du es mal eingegeben und es hat geklappt? Hab die Datei mit angefügt.
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.
Kannst du mir bitte die Datei schicken, kenn mich mit VBA gar nicht aus. Vielleicht mach ich da was falsch.
Danke im Voraus.
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.
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
Hallo,
ja, so habe ich es programmiert.
Habe wohl zu einfach gedacht.
Gleich stelle ich dann eine Korrektur ein.
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