Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
156to160
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
156to160
156to160
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nochmals Handzeichen

Nochmals Handzeichen
12.09.2002 15:36:14
wullux
Hallo,
nochmal zur Schilderung des Problems, weil ich es alleine doch nicht hinbekommen habe:
In Tabelle2 Zelle c2 soll nach Eintrag des Names und in Zelle c3 und des Vornamens in celle c4 automatisch ein Handzeichen erstellt werden.
Hierzu der Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim tb1 As Worksheet, tb2 As Worksheet
Set tb1 = Worksheets("tabelle1")
Set tb2 = Worksheets("tabelle2")
If tb2.Range("C2") <> "" And tb2.Range("C3") <> "" Then
tb2.Range("C4") = Mid(tb2.Range("C2"), 1, 2) & Mid(tb2.Range("C3"), 1, 1)
End If
End Sub

In tabelle1 Spalte c5:c500 stehen bereits vergebene Handzeichen.
Nun möchte ich durch eine Erweiterung erreichen, dass das zu erstellende Handzeichen zunächst mit den vergebenen Handzeichen verglichen und - falls bereits vorhanden - das Handzeichen aus den beiden ersten Buchstaben des Namens und dem 2. oder ggf. 3. etc. Buchstaben des Vornamens erstellt wird. Habe bereits viel rumexperimentiert, klappen tut jedoch kein Code.
Hier ein wahrscheinlich schlechtes Beispiel:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim tb1 As Worksheet
Dim tb2 As Worksheet
Dim z As Range
Dim s As Integer
Set tb1 = Worksheets("tabelle1")
Set tb2 = Worksheets("tabelle2")
s = 1
For Each z In tb1.Range("c5:c500")
If z = Mid(tb2.Range("C2"), 1, 2) & Mid(tb2.Range("C3"), s, 1) Then
s = s + 1
tb2.Range("C4") = Mid(tb2.Range("C2"), 1, 2) & Mid(tb2.Range("C3"), s, 1)
End If
Next
End Sub

Für jede Hilfe bin ich dankbar!
Gruss wullux

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Nochmals Handzeichen
12.09.2002 18:39:38
mathias r.
Code des Tabellenblattes:

Private Sub Worksheet_Activate()
Range("A1") = getHandzeichen(Range("C3"), Range("C2"))
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Range("A1") = getHandzeichen(Range("C3"), Range("C2"))
End Sub


Code im Modul oder Tabellenblatt:

Function getHandzeichen(Nachname As String, Vorname As String) As String
Dim tb1 As Worksheet
Dim tb2 As Worksheet
Dim sVorName As String
Dim sName As String
Dim rngSuch As Range
Dim rngFound As Range
Dim sTmp As String
Dim i As Integer
Set tb1 = Worksheets("Tabelle1")
Set tb2 = Worksheets("Tabelle2")
Set rngSuch = tb2.[C5:C500]
sName = tb1.[C2]
sVorName = tb1.[C3]
If sName <> "" And sVorName <> "" Then
For i = 2 To Len(sVorName)
sTmp = Left(sName, 2) & Left(sVorName, i)
Set rngFound = rngSuch.Find(What:=sTmp, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If rngFound Is Nothing Then
Exit For
End If
Next
End If
getHandzeichen = sTmp
End Function

Anzeige
Re: Nochmals Handzeichen
12.09.2002 18:42:29
Axel
Hallo,

teste mal unten stehenden Code

Gruß
Axel


Re: Nochmals Handzeichen
12.09.2002 20:32:05
wullux
Hallo mathias,
vielen Dank für Deine tolle Hilfe, hätte das wohl nicht hinbekommen! Perfekt!!!
Gruss wullux alias Dirk
Re: Nochmals Handzeichen
12.09.2002 20:34:10
wullux
Hallo Axel,
vielen Dank für den tollen Code und die beigefügte Erläuterung!
Wills ja auch selber einmal können und finds toll, dass Du mir so geholfen hast! Perfekt!!!!
Gruss wullux alias Dirk

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige