Gesprächsnotizen übertragen UweD

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
so?


Option Explicit
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
'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")
'Gesprächsnotizen eintragen
TB.Cells(Zeile, SpG).Resize(1, 18).Value = _
Application.Transpose(RNG3)
'KD Nr. Matchcode eintragen
Range("B3").FormulaR1C1 = "=R1C1" 'als Formel
Range("D3").FormulaR1C1 = "=R1C2"
'oder *****
Range("B3") = Range("A1") 'als Wert
Range("D3") = Range("B1")
'reset
Application.EnableEvents = False
RNG1 = "": RNG2 = ""
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

LG UweD

guten morgen,
in Maske "A1" bekomme ich die Kundennumer ( in "F1" stehen die =wenn....wennn...wenn.... die stehen im Zusammenhang mit Schreiben, Verlagen, etc.)
In Maske "B1" bekommen ich den Matchcode aus der Datenbank.
Nun ist ja eins wenn ich den Kunden 11 in die Maske "B3" eintrage, bekomme ich via "B1" in der Maske "D3"
den passenden Kunden ausgewiesen und automatisch in Maske "D4:D22" alle Kundendaten.
Dein Code mit der Kundennummer Maske "B3" funktioniert super ( geht immer auf max:Kundennummer) jedoch muss auch "D3" regenriert werden.
Nach Abschluß _____erledigt_____ geht "B3" in die Unsprungsstellung zurück und auch "D3" macht das, jedoch wenn ich jetzt einen neuen Kunden eingebe auf "B3" regeneriert sich "D3" nicht.
Im Prinzip müsste nach ____erledigt____ "B3" immer auf "A1" zugreifen und "D3" müsste auf "B1" zugreifen.
So das beim nächsten Kunden in der Maske "B3" den ich eingebe z.B. 22 auch "D3" den aktuellen Kunden ausweist und damit habe ich dann auch alle Kundendaten in der Maske "D4:D22"
"""die aktuelle Kd._Nr. und Matchcode siehst zu oben links stehen rote """"
wegen der Notiz habe ich die Maske umgebaut. aber komme ich später noch drauf.
Gruß Ralf

Beliebteste Forumthreads (12 Monate)

Gesprächsnotizen übertragen UweD

22 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread