Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
25.04.2024 11:49:37
Array verwenden
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1048to1052
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
1048to1052
1048to1052
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Handzeichen generieren

Handzeichen generieren
13.02.2009 13:32:00
heim102
Hallo,
ich möchte Handzeichen automatisch generieren lassen.
Für nur eine Zeile klappt dies prima.
Jedoch möchte ich das auf die ganzen spalten anwenden und da hab ich keine Ahnung wie ich das Makro auf einen spaltenbereich ändern muss.
Ausserdem sollte bei Handzeichengleichheit (z.B. müller waltraus =müw und Müller walter (wäre auch müw) der zweite Buchstabe des Nachnamen gesetzt werden (müa) ohne dass bereits vergebene Handzeichen geändert werden. (datenabgleich ob dieses Handzeichen bereits besteht)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Range("a1")  "" And Range("b1")  "" Then Range("c1") = Mid(Range("a1"), 1, 2) & Mid( _
Range("b1"), 1, 1)
End Sub


Name Vorname Handzeichen
stadler monika stm
Meier Peter mep (gleichheit)
meier pertud mee (2te Buchstabe des nachnamens)
kreefeldermichael krm
usw usw
ca 150 bis 200 zeilen
Über Eure Hilfe wäre ich sehr dankbar.
Grüsse
Michael

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Handzeichen generieren
13.02.2009 14:04:00
hary
Hallo Michael
fuer Dein erstes Prob. Diesen Code.

Dim zelle As Long
For zelle = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(zelle, 1)  "" And Cells(zelle, 2)  "" Then Cells(zelle, 3) = Mid(Cells(zelle, 1),  _
1, 2) & Mid( _
Cells(zelle, 2), 1, 1)
Next


Das zweite lass ich mal offen!!
Dein drittes Prob. Wie soll VBA wissen wo die Namen enden bzw anfangen?
kreemichael oder kreefeldermichael
Gruss Hary

AW: Handzeichen generieren
13.02.2009 14:26:00
heim102
Hallo Harry,
(Dein drittes Prob. Wie soll VBA wissen wo die Namen enden bzw anfangen?)
In Originaldatei stehen die Nachnamen in Spalte "c" , Vornamen in Spalte"d" und in Spalte "AP" sollen dann die Handzeichen generiert werden.
Wenn nun eine neuer Mitarbeiter eingetragen wird, (C) und (D) soll in (AP) das Kürzel generiert werde unter Beachtung der bereits vergebenen.
Vielen Dank nochmal
Gruß
Michael
Anzeige
AW: Handzeichen generieren
13.02.2009 15:38:00
hary
Hallo Michael
Kommt das dem schon nahe was Du suchst. Auf den Button klicken!
https://www.herber.de/bbs/user/59433.xls
Gruss Hary
Code vieeicht nicht schoen,aber zum Testen ;-)
AW: Handzeichen generieren
13.02.2009 19:27:00
Uwe
Hi,
ich war so frech und habe Harys Code ein bisschen (oder ein bisschen mehr (;-) ) umgebaut. Als Zugabe kommt, wenn auch die Möglichkeit des zweiten Buchstabens schon vergeben ist eine MsgBox ... manuell eintragen und die Zelle wird auf ? gesetzt.

Sub Ellipse1_BeiKlick()
Dim Zelle As Long
For Zelle = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(Zelle, 1)  "" And Cells(Zelle, 2)  "" _
And Cells(Zelle, 3) = "" _
And Cells(Zelle, 3)  "?" Then
Select Case WorksheetFunction.CountIf(Range("C:C"), Mid(Cells(Zelle, 1), 1, 2) & Mid( _
Cells(Zelle, 2), 1, 1))
Case Is > 0
If WorksheetFunction.CountIf(Range("C:C"), Mid(Cells(Zelle, 1), 1, 2) & Mid(Cells( _
Zelle, 2), 2, 1)) > 0 Then
MsgBox Cells(Zelle, 3).Address & _
"(" & Cells(Zelle, 1).Value & ", " & Cells(Zelle, 2).Value & ")" _
& Chr(13) & " bitte manuell vergeben"
Cells(Zelle, 3) = "?"
Else
Cells(Zelle, 3) = Mid(Cells(Zelle, 1), 1, 2) & Mid(Cells(Zelle, 2), 2, 1)
End If
Case Is = 0
Cells(Zelle, 3) = Mid(Cells(Zelle, 1), 1, 2) & Mid(Cells(Zelle, 2), 1, 1)
End Select
End If
Next
End Sub


Vielleicht hilft es ja?!
Gruß
Uwe
(:o)

Anzeige
AW: als Formellösung
14.02.2009 13:15:00
Daniel
Hi
diese Formel in Spalte C2 eintragen und nach unten kopieren (Nachnamen in Spalte A, Vornamen in Spalte B)
=WENN(ZÄHLENWENN($C$1:C1;LINKS(A2;2)&LINKS(B2;1))=0;LINKS(A2;2)&LINKS(B2;1);LINKS(A2;2)&TEIL(A2;2;1))
doppelte Handzeichen nach Regel 1 werden ausgeschlossen, sollten allerdings auch Handzeichen der Regel 2 doppelt vorkommen müsstest du dies von Hand nochmal prüfen.
Gruß, Daniel
AW: als Formellösung
14.02.2009 17:56:00
heim102
Hallo,
vieeelen Dank für die schnellen Lösungen.
Ich probier am 16.2. mal alle aus und sag schon jetzt mal Danke.
Gruß
Michael

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige