Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1760to1764
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten verschwinden

Daten verschwinden
06.06.2020 10:16:26
Ralf
Halle alle zusammen,
Ich benötige Eure Hilfe, vielleicht könnt ich mir weiter helfen.
Ich stehe vor dem Problem, in der Maske "B3" rufe ich den Kunden , dann sollen in der Maske "P10 bis P27" die bereits
vorhandenen Notizen ( die in der Datenbank "AO" bis"BF" abgelegt sind erscheinen. die Eingabe der Notizen erfolgt über die Maske "O10 bis O27". der Vorgang wird mit der Eingabe in der Wiedervorlage ____erledigt____.
wenn ich eine neue Kundennummer in der Maske "B3" eingeben, stehen immer noch in "O10 bis O27" die letzen Eingabenottizen
vom vorherigen Kunden drin. setzte ich im Worksheet ein "RNG3 = "" dann verschwinden die bereits vorhandenen Notizen
und nur die neue Notiz die ich in "O" eingetragen habe werden abgelegt,
Es sollte so sein, wenn ich einen Kunden aufrufe, sollen in der Maske" P10 bis P27" die vorherigen Einträge bleiben so das ich dann in der nächsten freien Zeile "O__" meine neue Notiz dazu schreiben kann.
Abschließend alle Notizen die ich eingegeben habe sollen erhalten bleiben,
ich habe dazu eine Probedatei mit gesenden, in Maske"O10" und "P10" habe ich einen KOMMENTAR als Beschreibung
vielleicht kann mir einer von euch helfen
Ansonsten läuft alles super, nur gesagt da besteht das Problem
https://www.herber.de/bbs/user/138067.xlsm
Gruß Ralf

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten verschwinden
06.06.2020 14:08:05
Ralf
Hilfe bitte
AW: Daten verschwinden
06.06.2020 14:24:08
ralf_b
erstmal ne Frage. Sind das echte, reale Daten in deiner Beispieldatei?
AW: Daten verschwinden
06.06.2020 14:26:11
Ralf
Hallo Ralf,
sind einfach so aus dem Internet zusammen gesucht, also frei zugängliche Daten
Gruß Ralf
AW: Daten verschwinden
06.06.2020 18:28:08
ralf_b
Alsoooo, da du in einem anderem Thread schreibst, du würdest dich nicht mit vba auskennen, hast du wohl einige Probleme zu lösen.
Ein Anfang mit vba ist ja bereits vorhanden. Stammt der auch aus dem Netz oder von einem Vorgänger in deinem Datenbankprojekt?
Der Mix aus Formeln und VBA ist schwierig zu beherrschen.
Eine Datenbank benötigt mehr als nur einen Scriptdurchlauf im Changeereignis.
1. Jede Zelländerung aktiviert das Changeereignis. Egal welche Zelle du änderst. Jedes Mal wird dein vba Script abgearbeitet.
Wenn Du Datum und Uhrzeit eingibst dann ist dein vba schon zweimal durchlaufen.
Hier sind evtl viel mehr Abfragen nötig um deine speziellen Abläufe zu bewerten und zu steuern.
2. Wenn in B3 eine andere Kundennummer eingetragen wird, solltest du den Bereich Notizen leer machen, bevor du ihn neu füllst. Ich vermute du verwendest Spalte O für neue Einträge und Spalte P für die alten Notizen. Ich habe eine Änderung für dich damit du in Spalte P in der gelben Zeile eine neue Notiz schreiben kannst. Dann wäre Spalte O überflüssig. Es wäre nur noch die Änderung der bedingten Formatierung nötig. damit man die neue Notiz besser lesen kann.
Beachte aber das sobald eine neue Notiz geschrieben wurde wieder dein vba script arbeitet. Deshalb muß im Script geprüft werden was gerade geschehen ist und was passieren soll.
folgende Änderungen im Script
'RNG4 hinten hinzufügen
Dim RNG1 As Range, RNG2 As Range, RNG3 As Range, RNG4 As Range
'bereich definieren unter die anderen Set anweisungen
Set RNG4 = Range("P10:P27") 'Notizen2
'gleich unter Set RNG4 die If Abfrage einfügen
'Notizen werden nur geändert wenn sich B3 ändert und nicht 44 drin steht. 44 scheint ein Defaultwert zu sein
If Target.Address(0, 0) = "B3" And Target 44 Then
Zeile = WorksheetFunction.Match(Target, TB.Columns(SpK), 0)
RNG4 = ""
RNG4 = Application.Transpose(TB.Cells(Zeile, SpG).Resize(1, 18))
End If
im folgenden Code änderst du bei transpose von RNG3 auf RNG4
'Gesprächsnotizen eintragen
TB.Cells(Zeile, SpG).Resize(1, 18).Value = _
Application.Transpose(RNG4)
Anzeige
AW: Daten verschwinden
06.06.2020 18:46:47
ralf_b
füge noch ein "exit sub" ein wie hier unten
RNG4 = Application.Transpose(TB.Cells(Zeile, SpG).Resize(1, 18))
exit sub
End If
und das "And Target 44 " kann weg, Habe jetzt erst gelesen das es ja dein letzter kunde ist.
AW: Daten verschwinden
06.06.2020 19:22:31
Ralf
Hallo kannst du mir bitte ein Gefallen tun
und mit den mir den kompletten Code zu senden das ich nur kopieren muss, wenn ich da was einfüge, geht es 1000% schief,
ich kenne mich doch
Gruß Ralf
AW: Daten verschwinden
06.06.2020 19:30:05
ralf_b
versuchs doch einfach erst mal. speichern nicht vergessen.
AW: Daten verschwinden
06.06.2020 19:34:48
fcs
Hallo Ralf,
ich hab das Makro in deiner Datei angepasst, so dass Notzeingaben gespeichert und in Spalte O gelöscht werden.
https://www.herber.de/bbs/user/138087.xlsm
Schau mal ob es so passt,
LG
Franz
Anzeige
AW: Daten verschwinden
06.06.2020 19:52:32
Ralf
Hallo Franz
ich danke dir vielmals genauso habe ich es mir vorgestellt, klappt soweit ganz gut.
Ich bedanke mich vielmals und wünsche dir noch ein schönes Wochenende
Gruß Ralf
AW: Daten verschwinden
06.06.2020 19:59:50
ralf_b
War da nicht noch eine Notwendigkeit von Datum und Zeit damit die Notiz eingetragen werden kann?
AW: Daten verschwinden
06.06.2020 20:05:47
Ralf
Funtioniert ganz gut einmal die Notiz bestätigen
und dann das Datum und Zeit ____erledigt______
klapp eigentlich ganz gut
man könnte es auch so machen dass erst mnit dem Datum und Zeit alles endgültig abgespeichert wird.
Aber ich bin ja schon GLÜCKLICH das dass so klappt, Vorher musste ich imm auf Die datenbank gelbe balken dan freie Spalte AO - BF und dort eintraten ausgesproch blakkkk
Dank
Gruß
Ralf
Anzeige
AW: Daten verschwinden
06.06.2020 20:12:50
ralf_b
nunja gespeichert wird da eigentlich nichts. falls deine Datei nicht irgendwann richtig gespeichert wird und der Rechner abstürzt verlierst du die Daten, die seit der letzten Automatischen Speicherung geschrieben wurden.
Ist das Projekt dein Baby oder hast du das geerbt?
AW: Daten verschwinden
06.06.2020 20:12:50
ralf_b
nunja gespeichert wird da eigentlich nichts. falls deine Datei nicht irgendwann richtig gespeichert wird und der Rechner abstürzt verlierst du die Daten, die seit der letzten Automatischen Speicherung geschrieben wurden.
Ist das Projekt dein Baby oder hast du das geerbt?
AW: Daten verschwinden
06.06.2020 20:33:33
Ralf
alles was normale Sachen sind normale ( WENN UND ODER SVERWEIS ) Maske, Datenbank etc. das ist auf mein Mist gewachsen,
die Worksheet das hat mir einer aus der Community geschrieben, wie schon anfangs erwähnt, VBA, Makros, Worksheet, davon habe ich absolut Null Ahnung!!
Ich mache jeden oder jeden 2. Abend Datensicherung auf meinen Stik.
Gruß Ralf
Anzeige
AW: Daten verschwinden
06.06.2020 20:34:36
Ralf
alles was normale Sachen sind normale ( WENN UND ODER SVERWEIS ) Maske, Datenbank etc. das ist auf mein Mist gewachsen,
die Worksheet das hat mir einer aus der Community geschrieben, wie schon anfangs erwähnt, VBA, Makros, Worksheet, davon habe ich absolut Null Ahnung!!
Ich mache jeden oder jeden 2. Abend Datensicherung auf meinen Stik.
Gruß Ralf
AW: Daten verschwinden
06.06.2020 20:36:29
fcs
Hallo Ralf,
wenn die Notiz erst nach Eingabe von Datum und Zeit des neuen Termin zur Wiedervorlage gespeichert werden soll, dann mit folgender angepassten Version des Makros.
LG
Franz
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TB As Worksheet, Kunu, Datum, Zeit, Zeile As Long
Dim SpK As Integer, SpD As Integer, SpR As Integer, SpG As Integer
Dim RNG1 As Range, RNG2 As Range, RNG3 As Range, Zelle As Range
'On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
Set TB = Sheets("Datenbank")
SpK = 4 'Spalte der Kundennummer =D
SpD = 14 'Spalte mit Datum =N
SpR = 8 'Spalte mit Restdaten =H
SpG = 41 'Spalte mit Gespächsnotizen = AO
Set RNG1 = Range("B25:G25") 'Restdaten
Set RNG2 = Range("D27,G27") 'Datum Uhrzeit
Set RNG3 = Range("O10:O27") 'Notizen
'nur bei Änderungen in diesen Zellen auslösen
If Not Intersect(Union(RNG1, RNG2), Target) Is Nothing Then
Kunu = Range("B3")
If WorksheetFunction.CountIf(TB.Columns(SpK), Kunu) > 0 Then
'Kunde bereits vorhanden?
Zeile = WorksheetFunction.Match(Kunu, TB.Columns(SpK), 0)
Else
'Kunde nicht vorhanden?
MsgBox "Kundennummer nicht gefunden"
Exit Sub
End If
If Not Intersect(RNG1, Target) Is Nothing Then
'Restdaten eintragen
TB.Cells(Zeile, SpR).Offset(0, Target.Column - 2) = Target
End If
If Not Intersect(RNG2, Target) Is Nothing Then
Datum = Range("D27")
Zeit = Range("G27")
'Datum / Zeit; Beides muss eingetragen sein
If IsDate(Datum) And IsNumeric(Zeit) And Zeit  0 Then
'Zeit und Datum eintragen
TB.Cells(Zeile, SpD) = Datum
TB.Cells(Zeile, SpD + 1) = Format(Zeit, "hh:mm")
'KD Nr. Matchcode eintragen
Range("B3").FormulaR1C1 = "=R1C1" 'als Formel
Range("D3").FormulaR1C1 = "=R1C2"
'Gesprächsnotizen eintragen/löschen
For Each Zelle In RNG3
If Zelle.Text  "" Then
If Target.Offset(0, 1).Text  "0" Then
If MsgBox("Soll die vorhandene Notiz in der Zeile " _
& Zelle.Row & " überschrieben werden?", _
vbQuestion + vbOKCancel + vbDefaultButton2, _
"Eintrag überschreiben") = vbOK Then
TB.Cells(Zeile, SpG).Offset(0, Zelle.Row - 10) = _
Zelle.Text
End If
Else
TB.Cells(Zeile, SpG).Offset(0, Zelle.Row - 10).Value = _
Zelle.Text
End If
End If
Next
'reset
Application.EnableEvents = False
RNG1 = "": RNG2 = "": RNG3 = ""
Application.EnableEvents = True
MsgBox "Erledigt"
End If
End If
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number  0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Anzeige
AW: Daten verschwinden
06.06.2020 20:59:43
Ralf
PERFEKT
Danke vielmals
Gruß Ralf

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige