Live-Forum - Die aktuellen Beiträge
Datum
Titel
10.05.2024 07:04:14
nicht löschbar
09.05.2024 19:15:00
speichern über Makro ändert bedingt formatierte Zellen
09.05.2024 15:49:16
OEE Verlust als Linie an OEE
09.05.2024 13:10:18
Pivot-Tabelle mit Monaten und nicht Tagen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1936to1940
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1936to1940
1936to1940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Dauerhafte Kundennummer per VBA erzeugen

Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 11:52:27
Torsten Riemer
Liebe Excelgemeinde,
ich bitte um Hilfestellung zur Lösung meiner folgenden Aufgabe.

Es sollen in einer Vereinsmitgliedertabelle in einer intelligenten Tabelle je eine Familiengruppennummer (FamGrNr), pro einzelnen Familienmitglied je eine laufende Nummer (FamMgNr) innerhalb der Familie und anschließend daraus resultierend je eine Mitgliedsnummer (MgNr) per VBA beim Speichern der Datei erstellt werden.

Der Code in meiner Beispielmappe https://www.herber.de/bbs/user/159959.xlsm funktioniert noch nicht wie gewünscht.

Folgende Vorgaben müssen erfüllt sein:
- Pro Familie soll in Spalte „FamGrNr“ eine fortlaufende Gruppennummer erstellt werden.

- Pro Familienmitglied soll in Spalte „FamMgNr“ eine innerhalb der Familie fortlaufende Familienmitgliedsnummer erstellt werden.

- Anschließend soll in Spalte „MgNr“ eine dauerhafte Mitgliedsnummer erstellt werden.
Sie setzt sich zusammen aus den beiden letzten Ziffern des Jahres aus Spalte „FamErstBeitritt“, der „FamGrNr“, die mit führenden Nullen 4-stellig wird und der „FamMgNr“, die mit führenden Nullen 2-stellig wird.

- Wenn die Daten bereits in die Felder „FamGrNr“, „FamMgNr“ und „MgNr“ geschrieben wurden, dürfen diese nicht später durch den Code verändert oder aktualisiert werden, sie müssen dauerhaft erhalten bleiben.

- Die Zellen müssen nach dem Beschreiben mit Zellschutz versehen werden.

- Das Problem:
Auch, wenn die Zeilen anders sortiert werden oder wenn Zeilen oberhalb der bestehenden Zeilen oder zwischen den bestehenden Zeilen eingefügt werden, müssen den Vorgaben entsprechend neue Zeilen mit dem jeweiligen Max-Wert für FamGrNr und FamMgNr ausgefüllt werden.
Die bereits vorhandenen Werte in „FamGrNr“, „FamMgNr“ und „MgNr“ dürfen auf keinen Fall verändert werden.

Für Eure Hilfe wäre ich sehr dankbar.
Viele Grüße, Torsten
https://www.herber.de/bbs/user/159959.xlsm

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 13:01:12
Rudi Maintaire
Hallo,
und wenn du 10 Meiers aus unterschiedlichen Familien hast?

Gruß
Rudi

AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 17:57:26
Torsten Riemer
Hallo Rudi, hallo Hardy,

den Namen einer Familie setze ich manuell eindeutig, z. B. Meier-ABCStraße, Meier-Müller usw. .
In den in meiner Beispieltabelle nicht aufgeführten Spalten „Name“ und „Vornamen“ stehen dann die tatsächlichen unterschiedlichen Namen der Mitglieder einer „Familie“.

Gruß, Torsten

AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 14:41:34
HardyR
Moin,

was du auch beachten musst, wenn eine Person einer Familiengruppe heiratet und einen anderen Namen annimmt, wie willst du das dann händeln?

Gruß
Hardy

Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 17:56:04
Torsten Riemer
Hallo Rudi, hallo Hardy,

den Namen einer Familie setze ich manuell eindeutig, z. B. Meier-ABCStraße, Meier-Müller usw. .
In den in meiner Beispieltabelle nicht aufgeführten Spalten „Name“ und „Vornamen“ stehen dann die tatsächlichen unterschiedlichen Namen der Mitglieder einer „Familie“.

Gruß, Torsten

AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 15:38:25
Daniel
Hi

probiers mal damit:
der Code prüft die Zeilen, bei denen noch keine Mitgliedsnummern eingetragen sind und vergibt diese dann entsprechen.
wenn auch das Eintrittsdatum fehlt, wird das aktuelle Datum verwendet.
Sortiertung ist eigentlich egal, die neuen Zeilen sollten nur unten stehen, damit, wenn die Familie schon vorhanden ist, auch die passende Nummer gefunden wird.
Den Schutz aufheben und wieder setzen solltest du selber hinbekommen.

Dim Zelle As Range
Dim Fam As String
Dim MgNr As String

If WorksheetFunction.CountBlank(Range("MgNr[FamGrNr]").Cells) > 0 Then
    For Each Zelle In Range("MgNr[FamGrNr]").SpecialCells(xlCellTypeBlanks)
        Fam = Intersect(Range("MgNr[Familie]"), Zelle.EntireRow).Value
        
        With Intersect(Range("MgNr[Beitritts-datum]"), Zelle.EntireRow)
            If .Value = "" Then .Value = Date
        End With
        
        If WorksheetFunction.CountIf(Range("MgNr[Familie]").Cells, Intersect(Range("MgNr[Familie]").Cells, Zelle.EntireRow).Value) = 1 Then
            Intersect(Zelle.EntireRow, Range("MgNr[FamMgNr]")) = 1
            Intersect(Zelle.EntireRow, Range("MgNr[FamGrNr]")) = WorksheetFunction.Max(Range("MgNr[FamGrNr]")) + 1
        Else
            Intersect(Zelle.EntireRow, Range("MgNr[FamMgNr]")) = WorksheetFunction.CountIf(Range("MgNr[Familie]"), Fam)
            Intersect(Zelle.EntireRow, Range("MgNr[FamGrNr]")) = WorksheetFunction.VLookup(Fam, Range("MgNr"), 4, 0)
        End If
        Intersect(Range("MgNr[MgNr]"), Zelle.EntireRow) = _
            (Year(Intersect(Range("MgNr[Beitritts-datum]"), Zelle.EntireRow)) Mod 100) * 1000000 + _
            Intersect(Range("MgNr[FamGrNr]"), Zelle.EntireRow) * 100 + _
            Intersect(Range("MgNr[FamMgNr]"), Zelle.EntireRow)
            
    Next

End If
Gruß Daniel

Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 18:30:31
Daniel
HI
noch ne kleine Optimierung.
momentan funktioniert der Code noch nicht korrekt wenn, du eine Familie neu mit mehreren Mitgliedern gleichzeitig anlegst.
damit auch das funktioniert, ändere diese Zeile:
If WorksheetFunction.CountIf(Range("MgNr[Familie]").Cells, Intersect(Range("MgNr[Familie]").Cells, Zelle.EntireRow).Value) = 1 Then
so ab:
If WorksheetFunction.CountIfs(Range("MgNr[Familie]").Cells, Intersect(Range("MgNr[Familie]").Cells, Zelle.EntireRow).Value, Range("MgNr[FamMgNr]").Cells, ">0") = 0 Then
Gruß Daniel

Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
18.07.2023 11:02:22
Torsten Riemer
Hallo Daniel,

vielen Dank für Deine Zeit und die geänderte Zeile. Ich habe ausführlich alle Möglichkeiten getestet, bei einigen gibt es Probleme:

1. Datensatz anlegen: OK
2. Datensatz mit selber Familie: OK
3. Datensatz mit neuer Familie: OK
4. Datensatz mit selber Familie: OK
Neuen Datensatz einer bestehenden Gruppe einfügen: OK
Neuen Datensatz einer neuen Gruppe innerhalb einfügen: OK

Neuen Datensatz einer neuen Gruppe oberhalb einfügen: OK

Neuen Datensatz einer bestehenden Gruppe oberhalb einfügen: NOK
Das Feld FamGrNr wird nicht geschrieben.

Mehrere Datensätze einer Familie anlegen: NOK
Werden z. B. 5 neue Zeilen für eine Familie angelegt, wird das erste Feld FamMgNr korrekt mit 1 beschrieben, die restlichen 4 Felder erhalten jeweils die 5, also die größte Menge der neu angelegten Zeilen.

Mehrere leere Felder in Spalte Familie: NOK:
FamGrNr zählt dennoch hoch, obwohl der Inhalt der Felder gleich ist (= leer)
(Deshalb habe ich Code eingebaut, der das Speichern verhindert, wenn in Spalte „Familie“ leere Felder sind.)

Gruß Torsten
https://www.herber.de/bbs/user/159969.xlsm

Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
18.07.2023 11:27:36
Daniel
Hi
du hast Excel 2019 und damit die Funktion MaxWenns.
die kann dir hier weiterhelfen.
ersetze mal das

Intersect(Zelle.EntireRow, Range("MgNr[FamMgNr]")) = WorksheetFunction.CountIf(Range("MgNr[Familie]"), Fam)
Intersect(Zelle.EntireRow, Range("MgNr[FamGrNr]")) = WorksheetFunction.VLookup(Fam, Range("MgNr"), 4, 0)
durch

Intersect(Zelle.EntireRow, Range("MgNr[FamMgNr]")) = WorksheetFunction.MaxIfs(Range("MgNr[FamMgNr]"), Range("MgNr[Familie]"), Fam) + 1
Intersect(Zelle.EntireRow, Range("MgNr[FamGrNr]")) = WorksheetFunction.MaxIfs(Range("MgNr[FamGrNr]"), Range("MgNr[Familie]"), Fam)
testen kann ich es leider nicht, da ich noch ein älteres Excel ohne MaxWenns habe.

Gruß Daniel

Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
18.07.2023 12:57:32
Torsten Riemer
Hallo Daniel,

Super!
Jetzt arbeitet es korrekt. Nur diese Variante geht nicht:
Mehrere leere Felder in Spalte Familie: NOK:
FamGrNr zählt dennoch hoch, obwohl der Inhalt der Felder gleich ist (= leer)

Aber ein Riesenproblem:
in meinem Verein hat der Freund (Schriftführer) leider nicht Excel 2019, deshalb hatte ich schon alle meine schönen Formeln, die WENNS enthielten, wieder umgebaut. Ich kann also WENNS nicht einsetzen.

Ich hatte vorhin schon geforscht, ob "CountIfs" in VBA, das Du gestern eingebaut hattest, wohl mit Excel 2016 funktioniert, habe ich aber noch nicht herausbekommen. Geht das mit Excel 2016?

Gruß Torsten

Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
18.07.2023 13:31:05
Daniel
ZählenWenns / Worksheetfunction.CountIfs
SummeWenns / Worksheetfunction.SumIfs
MittelwertWenns / Worksheetfunction.AverageIfs
gibts ab Excel 2007.
vor Excel 2007 nur ohne "s", also nur für eine Bedinung.
du hast jetzt gesehen wie es funktioniert, also kannst du auch selber überlegen, welche Funktionen du benötigst.

Gruß Daniel

AW: Dauerhafte Kundennummer per VBA erzeugen
18.07.2023 13:48:16
Torsten Riemer
Lieber Daniel,

ganz herzlichen Dank für Deine wertvolle Hilfe, ich habe eine schöne Lösung bekommen und Einiges dazugelernt.

Gruß Torsten

Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 19:59:22
Torsten Riemer
Hallo Daniel,

herzlichen Dank für den tollen Code.
Es ist für mich noch etwas schwer, ihn zu verstehen.
Leider funktioniert er noch nicht richtig, wenn mehrere Zeilen gefüllt werden und dann der Code durch das Speichern ausgeführt wird. In dem Falle werden die Zellen FamGrNr nicht und FamMgNr falsch gefüllt.
Wichtig ist mir auch, dass der Code auch dann funktioniert, wenn beliebig viele Zeilen oben oder zwischen vorhandenen Zeilen ausgefüllt werden. (Es müssen alle Fehlermöglichkeiten abgefangen werden, die z. B. durch das Bedienen der Tabelle durch andere, die sich nicht an die Konventionen halten, entstehen könnten)

Hast Du eine Idee, wie das zu lösen wäre?
Gruß Torsten

Anzeige
AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 20:48:42
Daniel
Hast du meine Nachbesserung eingebaut?

AW: Dauerhafte Kundennummer per VBA erzeugen
17.07.2023 23:52:22
Yal
Der Code von Daniel ist doch hervorragend.

Hier eine Version ohne Intersect (ob leichter zu verstehen...)

Sub Daniel()
Dim LR As ListRow
Dim cFam, cDat, cGrp, cMgl, cMNr
 
    With Range("MgNr").Parent.ListObjects("MgNr")
        If WorksheetFunction.CountBlank(.ListColumns("FamGrNr").Range) = 0 Then Exit Sub 'Keine Bearbeitungbedarf
        
        cFam = .ListColumns("Familie").Index
        cDat = .ListColumns("Beitritts-datum").Index
        cGrp = .ListColumns("FamGrNr").Index
        cMgl = .ListColumns("FamMgNr").Index
        cMNr = .ListColumns("MgNr").Index
        
        For Each LR In .ListRows
            If LR.Range(cGrp).Value = "" Then
                If LR.Range(cDat).Value = "" Then LR.Range(cDat).Value = Date
            
                If WorksheetFunction.CountIfs(.ListColumns(cFam).Range, LR.Range(cFam).Value, .ListColumns(cMgl).Range, ">0") = 0 Then
                    LR.Range(cGrp) = WorksheetFunction.Max(.ListColumns(cGrp).Range) + 1
                    LR.Range(cMgl) = 1
                Else
                    LR.Range(cGrp) = WorksheetFunction.VLookup(LR.Range(cFam).Value, .DataBodyRange, cGrp, 0)
                    LR.Range(cMgl) = WorksheetFunction.CountIf(.ListColumns(cFam).Range, LR.Range(cFam).Value)
                End If
                
                LR.Range(cMNr) = _
                    (Year(LR.Range(cDat).Value) Mod 100) * 1000000 + _
                    LR.Range(cGrp).Value * 100 + _
                    LR.Range(cMgl).Value
             End If
         Next
    End With
End Sub
VG
Yal

Anzeige

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige