Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1896to1900
1896to1900
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Eingegebene Kommentare wegspeichern

Forumthread: Eingegebene Kommentare wegspeichern

Eingegebene Kommentare wegspeichern
09.09.2022 07:17:49
Tobias
Hallo zusammen,
Ich habe folgende VBA-Thematik.
Ich habe eine Liste, die sich über 3 DropDown-Felder die entsprechenden Daten aus dem Blatt "Daten" zieht und diese dann als Liste (Blatt "Übersicht") anzeigt.
Nun gibt es in der Liste eine Spalte "Kommentar". Dort soll nach Auswahl der DropDown-Felder ein Kommentar eingegeben werden.
Allerdings wäre der Kommentar weg, wenn jemand neue filtert (Bei jeder Filterung werden die Datensätze verwertet, neu nummeriert usw.).
Nun meine Idee: Nach Eingabe eines Kommentars (immer Spalte J) wird die gesamte Zeile bzw. gesamten Zeilen (sagen wir bspw. J5 und J9) in ein neues Blatt "Kommentare" kopiert. Dies muss immer untereinander erfolgen, sprich immer an den letzten Datensatz anhängen. Nutzt ein anderer User das DropDown, muss es wieder darunter seine Kommentare kopieren usw. Das wäre Anforderung A.
Anforderung B: Nun, wenn jemand seinen Kommentar nochmal überarbeitet, kann ich den per SVERWEIS nicht aus dem Blatt "Kommentare" in die Liste ziehen, da der SVERWEIS ja nur immer den aktuellsten Datensatz nimmt. D.h. ich bräuchte auch hierfür noch eine Logik.
Könnt ihr mir hierzu bitte helfen bzgl. VBA-Code? Ich bin eher Anfänger :).
Danke und schöne Grüße
Tobias
Anzeige

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Eingegebene Kommentare wegspeichern
09.09.2022 08:20:07
UweD
Hallo
- Rechtsclick auf den Tabellenblattreiter von Übersicht
- Code anzeigen
- Den Code rechts reinkopieren

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TB As Worksheet, LR As Long, SP As Integer, Z As Variant
Set TB = Sheets("Kommentare")
SP = 10 'Spalte Quelle = J
If Not Intersect(Target, Columns(SP)) Is Nothing Then
For Each Z In Target.Rows
LR = TB.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
Rows(Z.Row).Copy TB.Rows(LR + 1)
Next
End If
End Sub
Bei Änderungen in Spalte J (auch bei Änderungen in mehreren Zeilen durch Strg Enter)
werden die Zeilen kopiert.
LG UweD
Anzeige
AW: Eingegebene Kommentare wegspeichern
09.09.2022 09:26:00
Tobias
Hallo Uwe,
vielen Dank für deine Hilfe.
Dein Makro kopiert mir die jeweiligen Zeilen, bei denen ich im Blatt "Übersicht" in eine beliebige Zelle in der Kommentarspalte "J" eine Eingabe mache ins Blatt "Kommentare".
Es wäre noch folgende Dinge wichtig:
- Datensätze ab Zeile 2 ff. in das Blatt "Kommentare" kopieren
- Prüfung, mittels einer eindeutigen Nummer (enthalten im Blatt Übersicht in Spalte D, für jede Zeile eine andere eindeutige Nummer), ob für diese Nummer bereits ein Datensatz MIT Kommentar im Blatt "Kommentare" vorliegt. Falls ja, müsste bei einer neuen Kommentar-Eingabe im Blatt "Übersicht" dieser Datensatz im Blatt "Kommentare" durch den neuen ersetzt werden. Falls nein, müssten die Datensätze mit weiteren Kommentareingaben darunter angehängt werden.
Danke und Grüße
Tobias
Anzeige
Anforderung
09.09.2022 08:21:15
MCO
Moin!
Versuch das mal:
du kopierst es in das Modul zum Tabellenblatt.
Nur bei Änderung in Spalte 10 ("J") schlägt der Code zu
Schlüsselbegriff wird gesucht und ggf gelöscht, dann neu zugefügt.
Du musst den Suchbegriff noch anpassen, ich bin davon ausgegangen dass "J5" der Schlüsselbegriff ist und in Spalte A gesucht wird.
Außdem bin ich davon ausgegangen, dass die Daten in Sheet 2 geschrieben werden...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim gefunden As Range
Dim lz As Long
If Target.Column = 10 Then
'erst kommentar finden + ggf. löschen
Set gefunden = Sheets(2).Range("A:A").Find(Cells("J5"), lookat:=xlWhole)
If Not gefunden Is Nothing Then Sheets(2).Rows(gefunden.Row).Delete
'dann neu schreiben
lz = Sheets(2).Cells("A" & Rows.Count).End(xlUp).Row + 1
Range("J5").Copy Sheets(2).Cells(lz, 1)
Range("J9").Copy Sheets(2).Cells(lz, 2)
End If
End Sub
Gruß, MCO
Anzeige
AW: Anforderung
09.09.2022 09:37:21
Tobias
Hallo MCO,
vielen Dank für deine Unterstützung.
Dein Makro kommt schon in die Nähe, was ich bräuchte.
Allerdings läuft das Makro in der Fett markierten Zeile auf Fehler (Laufzeitfehler S - Ungültiger Prozeduraufruf oder ungültiges Argument).
Darüber hinaus müsste das Makro noch folgendes können:
- Nicht nur Zeile 15 und Zelle 17 kopieren, sondern jede betroffene Zeile (vom Anfang Zeile 13 bis Ende der Liste, Listenlänge variabel), SOFERN in Spalte J ein Kommentar eingeben wird
- Im Blatt Übersicht ist in der Spalte D immer eine eindeutige Nummer für jede Zeile. Ist dieser Datensatz bereits im Blatt Kommentare enthalten UND wird der Kommentar im Blatt Übersicht in dieser Zeile neu eingegeben, so müsste im Blatt Kommentare der vorhandene gelöscht und durch den neuen Datensatz überschrieben werden. Alle weiteren Datensätze, sprich Eingaben von neuen Kommentaren, die bisher nicht im Blatt Kommentare enthalten sind, sollen darunter angefügt werden.
Danke weiterhin für deinen Support.
Gruß
Tobias
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim gefunden As Range
Dim lz As Long
If Target.Column = 10 Then
'erst kommentar finden + ggf. löschen
     Set gefunden = Sheets("Kommentare").Range("A:A").Find(Cells("Nr-12345-1"), lookat:=xlWhole)
If Not gefunden Is Nothing Then Sheets("Kommentare").Rows(gefunden.Row).Delete
'dann neu schreiben
lz = Sheets("Kommentare").Cells("A" & Rows.Count).End(xlUp).Row + 1
Range("J15").Copy Sheets("Kommentare").Cells(lz, 1)
Range("J17").Copy Sheets("Kommentare").Cells(lz, 2)
End If
End Sub

Anzeige
AW: Anforderung
12.09.2022 06:55:58
MCO
Moin!
Wenn du dir mal die Originalzeile ansiehst, dann wird in der Suchzeile auf die Zelle J5 verwiesen.
Wenn die bei Dir "Nr-12345-1" heißt (die Zelle, nicht der Suchbegriff!) dann sollte das so laufen. Ich glaube aber nicht, dass du die Zelle so benannt hast.
Zugegeben, das hab ich mit "dass "J5" der Schlüsselbegriff ist " falsch beschrieben. Es muss heißen "dass in Zelle "J5" der Schlüsselbegriff ist".
Der zweite Teil bleibt technisch unverändert. Nur die Syntax hab ich etwas abgekürzt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim gefunden As Range
Dim lz As Long
Dim komm_sh As Worksheet
Set komm_sh = Sheets("Kommentare")
If Target.Column = 10 And Target.Row >= 13 Then
If Cells(Target.Row, "D") = "" Then MsgBox "Die eindeutige Nummer fehlt", vbCritical + vbOKOnly, "Abbruch": Cells(Target.Row, "D").Select: Exit Sub
Set gefunden = komm_sh.Range("A:A").Find(Cells(Target.Row, "D"), lookat:=xlWhole) 'erst kommentar finden
If Not gefunden Is Nothing Then komm_sh.Rows(gefunden.Row).Delete '+ ggf. löschen
lz = komm_sh.Cells("A" & Rows.Count).End(xlUp).Row + 1 'letzte Zeile ermitteln
Cells(Target.Row, "D").Copy komm_sh.Cells(lz, 1)   'ID-Nummer neu schreiben
Target.Copy komm_sh.Cells(lz, 2) 'Kommentar neu schreiben
End If
End Sub
Gruß, MCO
Anzeige
AW: Anforderung
12.09.2022 12:00:31
Tobias
Hallo lieber MCO,
das ist ein Traum - funktioniert wunderbar. Herzlichen Dank dafür.
Ich gebe dir dafür ein virtuelles Bier aus :-).
Gäbe es - soz. als Upgrade - noch die Möglichkeit, dass wenn der User den Kommentar im Eingabeblatt "Übersicht" löscht, dieser Datensatz/Kommentar auch im Blatt "Kommentare" gelöscht wird?
Ansonst löscht der User zwar im Quellblatt den Kommentar, beim nächste Update der Tabelle wird allerdings dann wieder der noch im Blatt "Kommentar" bestehende Kommentar per SVERWEIS in die Liste gezogen (wo der ja nicht mehr hingehört).
Danke nochmal im Voraus für deine super Unterstützung.
Gruß
Tobias
Anzeige
AW: Anforderung
12.09.2022 13:01:02
MCO
Hi!
Ist doch quasi schon eingebaut:
Wenn ein Vorgang gefunden wird, wird er gelöscht und neu eingetragen, ob mit oder ohne Kommentar.
Wenn der nur reinsoll, wenn auch was drinsteht, dann musst du das Schreiben in eine Bedingung packen.:

if target.value "" then
lz = komm_sh.Cells("A" & Rows.Count).End(xlUp).Row + 1 'letzte Zeile ermitteln
Cells(Target.Row, "D").Copy komm_sh.Cells(lz, 1)   'ID-Nummer neu schreiben
Target.Copy komm_sh.Cells(lz, 2) 'Kommentar neu schreiben
endif
Gruß, MCO
Anzeige
AW: Anforderung
12.09.2022 13:47:31
Tobias
Vielen herzlichen Dank
AW: Anforderung
12.09.2022 14:43:36
Tobias
Hallo MCO,
ist mir schon langsam peinlich, aber ich habe nochmal eine Frage.
Bei Aufruf des Modul "Zurücksetzen" geht das Makro automatisch in das Blatt "Übersicht", bei dem das Makro von dir läuft:
Sub Zuruecksetzen()
Dim ErsteZeile
Dim ZielZeile
Dim i&, Zelle, LR&, RNG As Range
Application.ScreenUpdating = False
'Zeilen und Spalten einblenden
Rows("11:12").Select
Selection.EntireRow.Hidden = False
Columns("A:A").Select
Selection.EntireColumn.Hidden = False
' Autofilter zurücksetzen
With ActiveSheet
If .AutoFilterMode Then
For Each af In .AutoFilter.Filters
If af.On Then
.ShowAllData
Exit For
End If
Next
End If
End With
'Erste verformelte Zeile in Zeile 12 bis zur ZielZeile (Max. Anzahl Zeilen in Pivot) nach unten ziehen
ErsteZeile = ActiveSheet.Cells(2, 1)
ZielZeile = ActiveSheet.Cells(1, 1)
For x = ErsteZeile To ZielZeile + 12
Rows(ErsteZeile).Select
Selection.Copy
Rows(x).Select
ActiveSheet.Paste
Next
'Zeilen und Spalten ausblenden
Rows("11:12").Select
'Selection.Rows.Group 'Alternativ: Gruppierung setzen
Selection.EntireRow.Hidden = True
Columns("A:A").Select
Selection.EntireColumn.Hidden = True
'Formeln verwerten und nach der Spalte F sortieren
Rows("13:1000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Übersicht").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Übersicht").AutoFilter.Sort.SortFields.Add Key:= _
Range("F10:F12"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Übersicht").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call Nummerierung
Application.CutCopyMode = False
ActiveSheet.Range("A1:A1").Select
Application.ScreenUpdating = True
End Sub -----------------------
Bei der Fett markierten Zeile springt das Makro hierhin:
------------------------------
Option Explicit
'Change-Ereignis. Wenn eines der Dropdown-Felder betätigt wird, wird das Makro Zurücksetzen ausgeführt

Private Sub Worksheet_Change(ByVal Target As Range)
Dim gefunden As Range
Dim lz As Long
Dim komm_sh As Worksheet
Set komm_sh = Sheets("Kommentare")
'Wird im Blatt "Übersicht" ein Kommentar eingegeben, so wird dieser in das Blatt "Kommentare" geschrieben. Updates der Kommentare sind berücksichtigt.
If Target.Column = 10 And Target.Row >= 13 Then
If Cells(Target.Row, "D") = "" Then MsgBox "Die eindeutige Nummer fehlt", vbCritical + vbOKOnly, "Abbruch": Cells(Target.Row, "D").Select: Exit Sub
Set gefunden = komm_sh.Range("A:A").Find(Cells(Target.Row, "D"), lookat:=xlWhole) 'erst Kommentar finden
If Not gefunden Is Nothing Then komm_sh.Rows(gefunden.Row).Delete '+ ggf. löschen
End If
  If Target.Value  "" Then
lz = komm_sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile ermitteln
Cells(Target.Row, "D").Copy komm_sh.Cells(lz, 1)   'ID-Nummer neu schreiben
Target.Copy komm_sh.Cells(lz, 2) 'Kommentar neu schreiben
End If
'Wenn eines der Dropdown-Felder betätigt wird, wird das Makro Zurücksetzen ausgeführt
If Target.Address = "$E$6" Then
Call Zuruecksetzen
Call LeereZeilenLoeschen
Call Nummerierung
Call Druckbereich
End If
If Target.Address = "$E$7" Then
Call Zuruecksetzen
Call LeereZeilenLoeschen
Call Nummerierung
Call Druckbereich
End If
If Target.Address = "$E$8" Then
Call Zuruecksetzen
Call LeereZeilenLoeschen
Call Nummerierung
Call Druckbereich
End If
End Sub
Hier wiederum hängt es sich bei dem Zusatz "If Target.Value "" Then" auf -> Laufzeitfehler 13, Typen unverträglich.
Weißt du woran das liegt?
Danke und Grüße
Tobias
Anzeige
AW: Anforderung
13.09.2022 09:50:47
MCO
Ja, du versuchst Target als Wert zu behandeln, ohne erweiterung wir Target.value automatisch angenommen.
Wenn du aber eine ganze Zeile einfügst, läuft target.value auf einen Fehler.
Abhilfe:
Du steigst aus der Change-Prozedur aus 

if target.cells.count >1 then exit usb
oder
beim Kopieren und einfügen der Zeile schaltest du erst die Ereignisse ab und dann wieder an

application.events = false
'kopieren, einfügen
application.events = true
Gruß, MCO
Anzeige
AW: Anforderung
14.09.2022 13:29:28
Tobias
Hallo MCO,
das funktioniert super - Dankeschön :-).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim gefunden As Range
Dim lz As Long
Dim komm_sh As Worksheet
Dim komm_sh2 As Worksheet
Set komm_sh = Sheets("Kommentare")
Set komm_sh2 = Sheets("Kommentare2")
'Wird im Blatt "Übersicht" ein Kommentar eingegeben, so wird dieser in das Blatt "Kommentare" geschrieben. Updates der Kommentare sind berücksichtigt.
If Target.Column = 14 And Target.Row >= 13 Then
If Cells(Target.Row, "D") = "" Then MsgBox "Die eindeutige Nummer fehlt", vbCritical + vbOKOnly, "Abbruch": Cells(Target.Row, "D").Select: Exit Sub
Set gefunden = komm_sh.Range("A:A").Find(Cells(Target.Row, "D"), lookat:=xlWhole) 'erst Kommentar finden
If Not gefunden Is Nothing Then komm_sh.Rows(gefunden.Row).Delete '+ ggf. löschen
 If Target.Value  "" Then
lz = komm_sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile ermitteln
Cells(Target.Row, "D").Copy komm_sh.Cells(lz, 1)   'ID-Nummer neu schreiben
Target.Copy komm_sh.Cells(lz, 2) 'Kommentar neu schreiben
End If
End If
If Target.Column = 15 And Target.Row >= 13 Then
If Cells(Target.Row, "D") = "" Then MsgBox "Die eindeutige Nummer fehlt", vbCritical + vbOKOnly, "Abbruch": Cells(Target.Row, "D").Select: Exit Sub
Set gefunden = komm_sh2.Range("A:A").Find(Cells(Target.Row, "D"), lookat:=xlWhole) 'erst Kommentar finden
If Not gefunden Is Nothing Then komm_sh2.Rows(gefunden.Row).Delete '+ ggf. löschen
If Target.Value  "" Then
lz = komm_sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile ermitteln
Cells(Target.Row, "D").Copy komm_sh2.Cells(lz, 1)   'ID-Nummer neu schreiben
Target.Copy komm_sh2.Cells(lz, 2) 'Kommentar neu schreiben
End If
End If
Jetzt hab ich nur noch eine Erweiterung und das klappt noch nicht ganz. Erweiterung:
Ich habe nun noch eine zweite Kommentarspalte (Kommentarspalte 1 = "N", Kommentarspalte 2 = "O") eingefügt. Wenn ich nun in einer Zeile beide Kommentarspalten markiere und mit ENTF den Inhalt lösche, kommt wieder de Fehlermeldung "Laufzeitfehler 13 - Typen unverträglich". Danach sind die zwei Zellen zwar leer, ab in den beiden Kommentarblättern "Kommentare" und "Kommentare2" sind die Eingabe nach wie vor enthalten? Generell kann es auch sein, dass der Nutzer im DropDown seinen Namen auswählt und mehrere Kommentare gleichzeitig löscht. Das wäre somit Zeilenübergreifend.
Für eine letzte Hilfe wäre ich dir sehr Dankbar.
Gruß
Tobias
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige