Spalten kopieren zu Spaltenüberschrift

[luna101]

Guten Tag allerseits,
Bitte um Hilfe, da ich dies selber nicht zum Laufen bringe.

Mit dem Makro  "Sub Worksheet_Change(ByVal Target As Range)"
kopiere ich Daten von Spalten "AA" und "AD" nach "Vorname" und "BT", wobei "BT" variabel ist.
Wie muss ich das hier ändern,

If Mid(Range("AD" & i), 4, 2) = "01" Then
        Range("BT" & i) = Left(Range("AD" & i), 2) & " JAN " & Right(Range("AD" & i), 4)
End If

dass an Stelle der Spalte "BT" die Spaltenüberschrift "Geburtsdatum" ansprechen kann.
Habe es mit "Range("Geburtsdatum")" versucht, aber ohne Erfolg.
Mit freundlichen Grüssen
Martin

[LuckyJoe]

Hi,

die Spalte (als Zahl) findest du z.B. so:

Code:

Sub SucheUeberschriftSpalte()

    Dim FindeUeberschrift As Range
    Dim UeberschriftZeile As Long
    Dim UeberschriftSpalte As Long
    Dim Ueberschrift As String
   
    UeberschriftZeile = 1
    Ueberschrift = "Geburtsdatum"
   
    Set FindeUeberschrift = ActiveSheet.Rows(UeberschriftZeile).Find(Ueberschrift, , , xlWhole)
    If Not (FindeUeberschrift Is Nothing) Then
        UeberschriftSpalte = FindeUeberschrift.Column
        Debug.Print UeberschriftSpalte
    Else
        Debug.Print "Spalte mit der Überschrift '"; Ueberschrift; "' nicht vorhanden."
    End If

End Sub

[luna101]

Guten Tag Jörg,
für das Makro. Es ist leider nicht was ich suche.

Ich möchte, da Spalte "BU" variabel ist, im Makro "Datum1",
"BU" durch die Spaltenüberschrift "Geburtsdatum" ersetzen

Leider kriege ich das nicht hin und währe froh, wenn jemand helfen würde.

Gruss Martin

[Egon12]

Hallo Martin,

Jörg hat dir schon den richtigen Denkansatz zukommen lassen. Das was du von Excel willst, kann es nur über diese Umwege machen. Deine Spaltenüberschrift ist eben nur ein Zellinhalt. Die Methode .Find ist eine brauchbare Lösung deines Problems.

Gruß Uwe

[LuckyJoe]

Hi,

also so ganz verstehe ich dein Ansinnen nicht, aber:

- versuche mal, in deinem Makro "Datum1" mit Zellformatierungen zu arbeiten. Das von dir gewünschte Datum läßt sich einfacher über ein Zell- (Datums-) Format darstellen.

- verwende statt "Range("BU" & i) mal "Cells(Zeile, Spalte)", dann kannst du die von mir vorgestellte Routine verwenden, weil sie dir die gesuchte Spalte als Zahl zurückgibt

- ich bin mir zudem sicher, dass du das Ergebnis, was du erreichen möchtest, einfacher mit Formeln erreichst, aber wie gesagt: ich weiß nicht ganz, was du erreichen möchtest

[Egon12]

Hallo Martin,

ich habe das mal so umgestellt, dass sowohl statt Spalte AD nach "Geburts Datum" und statt Spalte BU nach "Geburtsdatum" gesucht wird und die so gefundene Spaltennummer weiterverarbeitet wird.
Dann habe ich falls du mal noch weitere Tabellenblätter verwenden solltest, dass gleich der Tabelle1 zugeordnet um zukünftige Fehlersuchereien zu verhindern.
Ich hoffe das hilft dir weiter.

Code:

Sub Datum1()
    Dim i As Long, j As Long, k As Long, Spalte1 As Range, Spalte2 As Range
    'Geburts Datum
    i = ActiveCell.Row
    With Tabelle1
        Set Spalte1 = .Rows(6).Find("Geburts Datum")
        If Not Spalte1 Is Nothing Then k = Spalte1.Column
        Set Spalte2 = .Rows(6).Find("Geburtsdatum")
        If Not Spalte2 Is Nothing Then j = Spalte2.Column
   
        If Mid(.Cells(i, k), 4, 2) = "01" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " JAN " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "02" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " FEB " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "03" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " MRZ " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "04" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " APR " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "05" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " MAI " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "06" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " JUN " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "07" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " JUL " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "08" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " AUG " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "09" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " SEPT " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "10" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " OKT " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "11" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " NOV " & Right(.Cells(i, k), 4)
        End If
        If Mid(.Cells(i, k), 4, 2) = "12" Then
            .Cells(i, j) = Left(.Cells(i, k), 2) & " DEZ " & Right(.Cells(i, k), 4)
        End If
    End With
End Sub

Gruß Uwe

[LuckyJoe]

... und dann kürzt du die Übernahme des Datumsformats noch wie folgt:

Code:

Sub Datum1()
   
    Dim i As Long, j As Long, k As Long, Spalte1 As Range, Spalte2 As Range
   
    'Geburts Datum
    i = ActiveCell.Row
   
    With Tabelle1
        Set Spalte1 = .Rows(6).Find("Geburts Datum")
        If Not Spalte1 Is Nothing Then k = Spalte1.Column
        Set Spalte2 = .Rows(6).Find("Geburtsdatum")
        If Not Spalte2 Is Nothing Then j = Spalte2.Column
       
        .Cells(i, j) = .Cells(i, k)
        .Cells(i, j).NumberFormat = "dd mmm yyyy"   ' <<-- noch besser: du formatierst das so in der Tabelle
       
    End With

End Sub

[Egon12]

Hallo Jörg,

das ist so eine Ahnenforschungssache. In einer früheren Anfrage sollte unbedingt der Monat in Großbuchstaben als Kürzel ausgegeben werden. Deshalb diese sperrige Umwandlung. Das konntest du natürlich nicht ahnen. Naja und dann kommt noch das Problem hinzu, dass die meisten Datumsangaben vorn dem excelschen Datumsnullpunkt liegen. Damit klappt das formatieren so nicht. Zumindest mein 2019'er Office erkennt das so nicht als Datum. 

Beste Grüße aus dem Erzgebirge
Uwe

[luna101]

Guten Abend Uwe,
für deine Hilfe. Es funktioniert 
Genau so wollte ich es haben.
Mit dankbaren Grüssen
Martin

---

Guten Abend Jörg,
 auch dir danke für deine Hilfe.
Werde dein Makro auch noch testen und melde mich wieder.

Das exotische Datum ändern und wieder zurück schreiben gibt
es nur wie vermutet in der Ahnenforschung.

Mit dankbaren grüssen
Martin

[luna101]

Guten Tag Jörg,
habe dein Makro getested. Es hat mir die Datum wie von Uwe
erwähnt nicht umgewandelt. Ja man muss in der Ahnenforschung
schon alles verbiegen und wieder strecken um ein richtiges
Ergebnis zu erhalten. Aber es hat mir gezeigt, wie mann das
Ansprechen von Überschriften erzeugt. Habe dadurch wieder
etwas gelernt
für deine Hilfe.
Grus aus der Schweiz
Martin