Office: (Office v.X. Mac) Verständnisfrage und Lösung für Namensliste (VBA)

Salü zäme,
ich bin neu hier und versuche mich an VBA. Grundkenntnisse sind vorhanden, dennoch stehe ich vor einem Problem, wo meine Logik im Moment aussetzt...

Ich habe eine Namensliste auf Tabellenblatt1 und eine Vorlage für den Ausdruck auf Tabellenblatt2.
Die Namensliste ist aufgebaut in der Form (SpalteA Vorname, SpalteB Nachname, usw.)
Auf der Vorlage zum Ausdrucken gibt es in Zelle 1,1 ein Feld für Nachnamen und in Zelle 2,1 und 3,1 bzw. 4,1 ein Feld für die möglichen Vornamen.

Ich nutze eine UserForm, wo der Nachname aus der ComboBox ausgewählt werden kann und dieser wird auch in die Zelle 1,1 geschrieben. Nun brauche ich eine Logik, die mir den Nachnamen checked und jeden möglichen Formnamen in die Zellen 2,1 ... einträgt.

Also so in der Art, wenn der Nachname nur einmal vorkommt, nimm den Vornamen und trage ihn in Zelle 2,1 ein. Wenn der Nachname mehr als nur einmal vorkommt, dann trage die Vornamen in die Zellen 2,1 3,1 usw. ein.

Wie kann ich das umsetzen.
Danke und Gruss, Mario.

 

Hallo MarioMagnus,

nimm den Nachnamen und durchlaufe die Liste im Tabellenblatt1 bis zum Ende mit einer ForNext- oder ForEach-Schleife. Immer, wenn dein Name mit dem Namen in der Liste übereinstimmt, schreibe den Vornamen in die nächste freie Zelle in Blatt2.

Gruß,
Lutz

 

Salü Lutz,
danke für den Hinweis mit der ForNext Schleife...
jetzt muss ich nur noch schauen, wie ich es in einen Codeschnipsel verpacke :)
Gruss, Mario.

 

Hallo Mario,

vielleicht hilft dieser Ansatz:

IntLetzteZeileMat = ActiveWorksheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For IntZeileMat = 1 To IntLetzteZeileMat
...
Next IntZeileMat​

Ist ungetestet...

Gruß,
Lutz

 

Salü Lutz,
danke für den Ansatz, werde ich mir ansehen und testen.
Gruss, Mario.

 

Warum auch immer....
VBA - Verständnisfrage und Lösung für Namensliste - MS-Office-Forum

 

Salü Steve,
wie im anderen Forum schon geantwortet...
Gruss, Mario.

 

Salü Lutz,
ich versuche mein Glück, aber ich habe keine Ahnung, wie ich die gefunden Vornamen in die Zellen untereinander schreiben soll...
ich verwende im Moment das (Asche auf mein Haupt, wenn es zu sehr nach Anfänger ausschaut):

Dim nNames As Long
Dim NachName As Variant

nNames = Worksheets("Kinder").Range("B65536").End(xlUp).Row
If nNames < 4 Then nNames = 5 'Die Nachnamen fangen erst in der 5. Zeile an
NachName = Range("Kinder!B5:B" & nNames)

For Each ComboBox_Familie.Value In NachName
... (hier fehlt mir der Ansatz, wie ich es formuliere...)
Next ComboBox_Familie.Value

Danke und gruss, Mario.

 

Hallo,

in der beiliegenden Excel-Datei habe ich dir eine kleine VBA-Funktion namens "GetVornamen(...)" eingebaut in ein allgemeines Codemodul.
Diese Funktion greift auf die strukturierte Tabelle "TabNamen" zu.
Sie ist eine Arrray-Funktion - deshalb im Bereich F2:F8 die geschweiften Klammern, während diese in H2:H8 nicht mehr nötig sind.

In Zelle F1 kann ein Nachname eingegeben werden, zu dem dann im Bereich F2:F8 bzw. im Bereich H2:H8 die dazugehörigen Vornamen aufgelistet werden (je nachdem welche Version für dein Excel infrage kommt).

Im Bereich F14:F21 bzw. H14:H21 habe ich dir 2 Formellösungen (mit Arbeitsblattfunktionen) eingefügt. Die dazugehörigen Formeln habe ich dir jeweils in brauner Farbe eingeblendet.

Die VBA-Funktion "GetVornamen" sieht wie folgt aus:

Code:

Public Function GetVornamen(strNachname As String, Optional TabName As String = "TabNamen") As Variant
   Dim lstRow As ListRow, SpN As Integer, SpV As Integer
   Dim arrRet() As String, I As Integer
  
   On Error GoTo Err_GetVorname
   I = 0: arrRet(0) = "": I = -1
  
   With ActiveSheet.ListObjects(TabName)
      SpN = .ListColumns("Nachname").Index
      SpV = .ListColumns("Vorname").Index
    
      For Each lstRow In .ListRows
        With lstRow.Range
          If .Cells(SpN) = strNachname Then I = I + 1: arrRet(I) = .Cells(SpV)
        End With
      Next lstRow
    
   End With
  
   GetVornamen = WorksheetFunction.Transpose(arrRet)
   Exit Function

Err_GetVorname:
   ReDim Preserve arrRet(I) As String
   Resume
  
End Function

 

Salü Anton,
danke Dir - schaue ich mir sofort an.
Gruss, Mario.

 

Hallo,

einige Verbesserungen und Umgehungen von Excel-Tücken in der folgenden Dateiversion:

 

Salü Anton,

zu meiner Schande muss ich gestehen, dass ich deine Function nicht verstehe - ich bin wohl doch zu sehr Laie.

Ich habe Dir mal den Code hinzugefügt, den ich aktuell verwende - leider gibt er mir noch einen Fehler aus, das er die Variable nicht verwenden kann in der For Schleife...

Code:

Private Sub CommandButton_Druck_Click()

    Dim vorlageWs As Worksheet
    Dim nNames As Long, vNames As Long
    Dim NachName As Variant, VorName As Variant
    Dim saveLocation As String
    Dim x As Long
  
    Set vorlageWs = Worksheets("Vorlage")

    nNames = Worksheets("Kinder").Range("B65536").End(xlUp).Row
    If nNames < 5 Then nNames = 5
  
    vNames = Worksheets("Kinder").Range("A65536").End(xlUp).Row
    If vNames < 5 Then vNames = 5

    x = 8
    NachName = Range("Kinder!B5:B" & nNames)
    VorName = Range("Kinder!A5:A" & vNames)

    For Each ComboBox_Familie.Value In NachName

        vorlageWs.Cells(x, 6) = WorksheetFunction.XLookup(ComboBox_Familie.Value, NachName, VorName)
        x = x + 1

    Next ComboBox_Familie.Value
  
    vorlageWs.Cells(6, 6).Value = ComboBox_Familie.Value
    vorlageWs.Cells(3, 6).Value = ComboBox_Monat.Value
  
'    Format(Date, "YYYY.MM")
  
    saveLocation = "/Users/.../.../.../Verrechnungen/Stundenblatt_" & vorlageWs.Cells(3, 6) & "_" & vorlageWs.Cells(6, 6)
  
    With vorlageWs.PageSetup
        .Orientation = xlPortrait
        .PrintArea = "A1:AB53"
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
    End With

    vorlageWs.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=saveLocation, _
        OpenAfterPublish:=True

    Unload Me
  
End Sub

Sorry wenn mein Code zu viel Unsinn enthält.
Danke und Gruss, Mario.

 

ok, jetzt schreibt er mir endlich auch einen Namen hin, aber nur den ersten, und nicht den zweiten obwohl es zwei Vornamen gibt mit demselben Nachnamen:

Code:

Private Sub CommandButton_Druck_Click()

    Dim vorlageWs As Worksheet
    Dim nNames As Long, vNames As Long
    Dim NachName As Variant, VorName As Variant
    Dim saveLocation As String, xName As Variant
    Dim x As Long
    Dim intDaysInMonth As Integer
    Dim i As Integer
 
    Set vorlageWs = Worksheets("Vorlage")

    nNames = Worksheets("Kinder").Range("B65536").End(xlUp).Row
    If nNames < 5 Then nNames = 5
   
    vNames = Worksheets("Kinder").Range("A65536").End(xlUp).Row
    If vNames < 5 Then vNames = 5

    x = 8
    NachName = Range("Kinder!B5:B" & nNames)
    VorName = Range("Kinder!A5:A" & vNames)

    xName = ComboBox_Familie.Value

    For Each xName In NachName

        vorlageWs.Cells(x, 6) = WorksheetFunction.XLookup(ComboBox_Familie.Value, NachName, VorName)
        x = x + 1

    Next xName
   
    vorlageWs.Cells(6, 6).Value = ComboBox_Familie.Value
    vorlageWs.Cells(3, 6).Value = ComboBox_Monat.Value
   
    saveLocation = "/Users/.../.../.../Verrechnungen/Stundenblatt_" & vorlageWs.Cells(3, 6) & "_" & vorlageWs.Cells(6, 6)
   
    Application.Wait (Now + TimeValue("0:01:00"))
   
    With vorlageWs.PageSetup
        .Orientation = xlPortrait
        .PrintArea = "A1:AB53"
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
    End With

    vorlageWs.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=saveLocation, _
        OpenAfterPublish:=True

    Unload Me
   
End Sub

Irgendeine Idee, was ich noch anpassen muss, damit der Code mir beide Vornamen angibt?
Danke und Gruss, Mario.

 

Hallo,

habe mir deinen VBA-Code angesehen - folgende Modifikationen würde ich vorschlagen:

Code:

Private Sub CommandButton_Druck_Click()

    Dim vorlageWs As Worksheet, kinderWs As Worksheet
    Dim saveLocation As String
    Dim x As Long
    Dim intDaysInMonth As Integer
    Dim i As Integer

    Dim NachName As Range, VorName As Range
    Dim xName As String, zelleName As Range
 
    Set vorlageWs = Worksheets("Vorlage")
    Set kinderWs = Worksheets("Kinder")
 
 
'   Damit die folgende Anweisung funktioniert,
'     - müssen im Bereich   A5:An   die Vornamen enthalten sein
'     - müssen im Bereich   B5:Bn   die Nachnamen enthalten sein
'     - muss  der Bereich   A5:Bn   von lauter Leerzellen umgeben sein
 
    Set NachName = kinderWs.Range("A5").CurrentRegion.Columns(2)
 
    x = 8
    xName = ComboBox_Familie.Value

    For Each zelleName In NachName.Cells
        If zelleName.Value = xName Then
           vorlageWs.Cells(x, 6).Value = zelleName.Offset(0, -1).Value
           x = x + 1
        End If
    Next zelleName
 
    vorlageWs.Cells(6, 6).Value = ComboBox_Familie.Value
    vorlageWs.Cells(3, 6).Value = ComboBox_Monat.Value
 
   '.... usw.
  '
 
End Sub

 

Salü Anton,
werde ich mir anschauen, und wollte gerade auch fragen, warum die umgebenen Zellen leer sein müssen, aber Google hat mir geholfen ".CurrentRegion" zu verstehen...

Ich bin Dir absolut dankbar, denn das ist genau die Lösung und sie funktioniert einwandfrei!!!
Danke und Gruss, Mario.