Registriert seit: 02.12.2016
Version(en): 2010
Hallo Excelianer:innen, hier habe ich vor einiger Zeit beim gleiche Thema Hilfe erhalten siehe (Spalten kopieren zu Spaltenüberschrift) und verwende das Makro von Uwe. Nun wollte ich das ganze erweitern, leider ohne Erfolg. Zusätzlich sollte noch ergänzt werden (Jahr- und Monatszahlen vaiabel): vor 1600 zu BEF 1600 um 1100 zu ABT 1100 nach 1500 zu AFT 1500 09 1300 zu SEP 1300 1200 zu 1200 Leider bin ich mit den Formeln etwas überfordert und bitte um Eure Hilfe. Gruss Martin
Datum Test 1.xlsm (Größe: 317,53 KB / Downloads: 11)
Registriert seit: 03.04.2020
Version(en): Office 365 und 2010
Hallo, versuche es einmal so: Code: 'in Modul 3 unten.....
Select Case Right(.Cells(i, k), 4)
Case Is <= 1200
.Cells(i, j) = "BEF " & Right(.Cells(i, k), 4)
'usw. usw.
End Select
Bei "um 1200" musst Du eben einen Zeitraum definieren z. B. >=1100 And <= 1300 oder wie auch immer. Den ersten Code - Schnipsel oben habe ich getestet und funktioniert. Grüße Norbert
Registriert seit: 02.12.2016
Version(en): 2010
Guten Tag Norbert,  für die Hilfe. Leider bringt es mir eine Fehlermeldung. Unzulässiger oder nicht ausreichend definierter Verweiss bei Select Case Right(.Cells(i, k), 4) Was mache ich falsch? Bitte nochmals um Hilfe. Gruss Martin
Datum Test 1(1).xlsm (Größe: 316,77 KB / Downloads: 6)
Registriert seit: 28.08.2022
Version(en): 365
Hi,
da du vor dem .Cells einen Punkt stehen hast, muss es natürlich mit in den With-Block!
Im Übrigen solltest du auch die anderen If-Anweisungen in Select Case umwandeln. Wäre viel übersichtlicher
Gruß,
Helmut
Win10 - Office365 / MacOS - Office365
Registriert seit: 21.12.2017
Version(en): MS 365 Family (6 User x 5 Geräte für jeden) Insider-Beta
09.12.2022, 17:41
(Dieser Beitrag wurde zuletzt bearbeitet: 09.12.2022, 17:46 von LCohen.)
BY7#:
=LET(
a;AD7:AD16;
x;RECHTS("01.01."&a;10);
y;WECHSELN(WECHSELN(GROSS(TEXT(ERSETZEN(x;7;1;TEIL(x;7;1)+2);"T MMM JJJJ"));" 3";" 1");" 4";" 2");
z;WAHL(LÄNGE(a)-LÄNGE(WECHSELN(a;".";))+1;RECHTS(y;4);RECHTS(y;8);y);
WENNFEHLER(VERWEIS(a;{"n"."u"."v"};{"AFT "."ABT "."BEF "});"")&z)
nur ab dem Jahr 1000. Für Jahre davor bitte melden.
Achtung: Nur neues Excel!
Registriert seit: 02.12.2016
Version(en): 2010
Guten Abend LCohen,
besten Dank für Dein Beispiel. Interessanter Vorschlag.
Leider arbeite ich immer noch mit Excel 2016.
Trotzdem nochmals danke für die Hilfsbereitschaft.
Gruss Martin
Registriert seit: 21.12.2017
Version(en): MS 365 Family (6 User x 5 Geräte für jeden) Insider-Beta
09.12.2022, 19:56
(Dieser Beitrag wurde zuletzt bearbeitet: 09.12.2022, 19:59 von LCohen.)
War auch nur Gehirnschmirgelgrundlage. Manchmal braucht man das. Etwas verkürzt ohne WAHL:
=LET(
a;AD7:AD16;
x;RECHTS("01.01."&a;10);
y;WECHSELN(WECHSELN(GROSS(TEXT(ERSETZEN(x;7;1;TEIL(x;7;1)+2);"T MMM JJJJ"));" 3";" 1");" 4";" 2");
z;RECHTS(y;(LÄNGE(a)-LÄNGE(WECHSELN(a;".";))+1)*4);
WENNFEHLER(VERWEIS(a;{"n"."u"."v"};{"BEF "."ABT "."AFT "});"")&z)
Registriert seit: 02.12.2016
Version(en): 2010
Guten Abend Helmut,
danke für die Info. Habe immer noch so meine Schwierigkeiten mit den If Aneisungen.
Dein Typ :
"da du vor dem .Cells einen Punkt stehen hast, muss es natürlich mit in den With-Block"
nicht so verständlich.
Dein Änderungsvorschlag "If-Anweisungen in Select Case umwandeln" ist sicher
von Vorteil, vor allem aber übersichtlicher.
Hier wären für mich Beispiele besser. So könnte ich meinen Bildungs-Horizont erweitern.
Nochmals Danke für deine Hilfbereischaft.
mfg. Martin
Registriert seit: 16.08.2020
Version(en): 2019 64bit
10.12.2022, 13:55
(Dieser Beitrag wurde zuletzt bearbeitet: 10.12.2022, 13:55 von Egon12.)
Hallo Martin, teste mal.
Datum Test 1.xlsm (Größe: 308,13 KB / Downloads: 17)
Naja, mittels Select Case spart man an dieser Front nur wenig, da ja die jeweiligen Zuweisungen (1 Befehlszeile) bleiben. Deshalb ist es so ziemlich egal, ob If/Else oder Select Case. Gruß Uwe
Registriert seit: 28.08.2022
Version(en): 365
10.12.2022, 16:23
(Dieser Beitrag wurde zuletzt bearbeitet: 10.12.2022, 16:25 von HKindler.)
Hi, (10.12.2022, 13:55)Egon12 schrieb: Naja, mittels Select Case spart man an dieser Front nur wenig, da ja die jeweiligen Zuweisungen (1 Befehlszeile) bleiben. Deshalb ist es so ziemlich egal, ob If/Else oder Select Case. dem möchte ich doch ein wenig widersprechen. Der bisherige Code mit If 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("Geburt-Datum")
If Not Spalte1 Is Nothing Then k = Spalte1.Column
Set Spalte2 = .Rows(6).Find("Geburt.-.Datum")
If Not Spalte2 Is Nothing Then j = Spalte2.Column
If Len(.Cells(i, k)) = 4 Then .Cells(i, j) = .Cells(i, k)
If Len(.Cells(i, k)) = 7 Then
If Left(.Cells(i, k), 2) = "01" Then
.Cells(i, j) = "JAN " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "02" Then
.Cells(i, j) = "FEB " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "03" Then
.Cells(i, j) = "MRZ " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "04" Then
.Cells(i, j) = "APR " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "05" Then
.Cells(i, j) = "MAI " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "06" Then
.Cells(i, j) = "JUN " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "07" Then
.Cells(i, j) = "JUL " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "08" Then
.Cells(i, j) = "AUG " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "09" Then
.Cells(i, j) = "SEPT " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "10" Then
.Cells(i, j) = "OKT " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "11" Then
.Cells(i, j) = "NOV " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 2) = "12" Then
.Cells(i, j) = "DEZ " & Right(.Cells(i, k), 4)
End If
Else
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
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
' .............Der folgende Eintrag ändert die Tage 01 bis 09 nach 1 bis 9 .........
If Left(Range("BT" & i), 1) = "0" Then Range("BT" & i) = Mid(Range("BT" & i), 2, 20)
If Left(.Cells(i, k), 4) = "vor " Then
.Cells(i, j) = "BEF " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 5) = "nach " Then
.Cells(i, j) = "AFT " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 3) = "um " Then
.Cells(i, j) = "ABT " & Right(.Cells(i, k), 4)
End If
End With
End Sub
Mit Select Case sieht das so aus Code: Sub Datum2()
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("Geburt-Datum")
If Not Spalte1 Is Nothing Then k = Spalte1.Column
Set Spalte2 = .Rows(6).Find("Geburt.-.Datum")
If Not Spalte2 Is Nothing Then j = Spalte2.Column
If Len(.Cells(i, k)) = 4 Then .Cells(i, j) = .Cells(i, k)
If Len(.Cells(i, k)) = 7 Then
Select Case Left(.Cells(i, k), 2)
Case "01"
.Cells(i, j) = "JAN " & Right(.Cells(i, k), 4)
Case "02"
.Cells(i, j) = "FEB " & Right(.Cells(i, k), 4)
Case "03"
.Cells(i, j) = "MRZ " & Right(.Cells(i, k), 4)
Case "04"
.Cells(i, j) = "APR " & Right(.Cells(i, k), 4)
Case "05"
.Cells(i, j) = "MAI " & Right(.Cells(i, k), 4)
Case "06"
.Cells(i, j) = "JUN " & Right(.Cells(i, k), 4)
Case "07"
.Cells(i, j) = "JUL " & Right(.Cells(i, k), 4)
Case "08"
.Cells(i, j) = "AUG " & Right(.Cells(i, k), 4)
Case "09"
.Cells(i, j) = "SEPT " & Right(.Cells(i, k), 4)
Case "10"
.Cells(i, j) = "OKT " & Right(.Cells(i, k), 4)
Case "11"
.Cells(i, j) = "NOV " & Right(.Cells(i, k), 4)
Case "12"
.Cells(i, j) = "DEZ " & Right(.Cells(i, k), 4)
End Select
Else
Select Case Mid(.Cells(i, k), 4, 2)
Case "01"
.Cells(i, j) = Left(.Cells(i, k), 2) & " JAN " & Right(.Cells(i, k), 4)
Case "02"
.Cells(i, j) = Left(.Cells(i, k), 2) & " FEB " & Right(.Cells(i, k), 4)
Case "03"
.Cells(i, j) = Left(.Cells(i, k), 2) & " MRZ " & Right(.Cells(i, k), 4)
Case "04"
.Cells(i, j) = Left(.Cells(i, k), 2) & " APR " & Right(.Cells(i, k), 4)
Case "05"
.Cells(i, j) = Left(.Cells(i, k), 2) & " MAI " & Right(.Cells(i, k), 4)
Case "06"
.Cells(i, j) = Left(.Cells(i, k), 2) & " JUN " & Right(.Cells(i, k), 4)
Case "07"
.Cells(i, j) = Left(.Cells(i, k), 2) & " JUL " & Right(.Cells(i, k), 4)
Case "08"
.Cells(i, j) = Left(.Cells(i, k), 2) & " AUG " & Right(.Cells(i, k), 4)
Case "09"
.Cells(i, j) = Left(.Cells(i, k), 2) & " SEPT " & Right(.Cells(i, k), 4)
Case "10"
.Cells(i, j) = Left(.Cells(i, k), 2) & " OKT " & Right(.Cells(i, k), 4)
Case "11"
.Cells(i, j) = Left(.Cells(i, k), 2) & " NOV " & Right(.Cells(i, k), 4)
Case "12"
.Cells(i, j) = Left(.Cells(i, k), 2) & " DEZ " & Right(.Cells(i, k), 4)
End Select
End If
' .............Der folgende Eintrag ändert die Tage 01 bis 09 nach 1 bis 9 .........
If Left(Range("BT" & i), 1) = "0" Then Range("BT" & i) = Mid(Range("BT" & i), 2, 20)
If Left(.Cells(i, k), 4) = "vor " Then
.Cells(i, j) = "BEF " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 5) = "nach " Then
.Cells(i, j) = "AFT " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 3) = "um " Then
.Cells(i, j) = "ABT " & Right(.Cells(i, k), 4)
End If
End With
End Sub
Vor allem wird hier nur einmal LEFT(xxx, 2) bzw. MID(xxx,4, 2) ausgeführt. Das beschleunigt die Durchführung um den Faktor 12. Durch Zuweisung der Monatsnamen zu einer Variablen und Eintragen in die Zelle nach dem Select Case könnte man das noch etwas eleganter machen: Code: Sub Datum3()
Dim i As Long, j As Long, k As Long, Spalte1 As Range, Spalte2 As Range
Dim s As String
'Geburts Datum
i = ActiveCell.Row
With Tabelle1
Set Spalte1 = .Rows(6).Find("Geburt-Datum")
If Not Spalte1 Is Nothing Then k = Spalte1.Column
Set Spalte2 = .Rows(6).Find("Geburt.-.Datum")
If Not Spalte2 Is Nothing Then j = Spalte2.Column
If Len(.Cells(i, k)) = 4 Then .Cells(i, j) = .Cells(i, k)
If Len(.Cells(i, k)) = 7 Then
Select Case Left(.Cells(i, k), 2)
Case "01"
s = "JAN "
Case "02"
.Cells(i, j) = "FEB "
Case "03"
s = "MRZ "
Case "04"
s = "APR "
Case "05"
s = "MAI "
Case "06"
s = "JUN "
Case "07"
s = "JUL "
Case "08"
s = "AUG "
Case "09"
s = "SEPT "
Case "10"
s = "OKT "
Case "11"
s = "NOV "
Case "12"
s = "DEZ "
End Select
.Cells(i, j) = s & Right(.Cells(i, k), 4)
Else
Select Case Mid(.Cells(i, k), 4, 2)
Case "01"
s = " JAN "
Case "02"
s = " FEB "
Case "03"
s = " MRZ "
Case "04"
s = " APR "
Case "05"
s = " MAI "
Case "06"
s = " JUN "
Case "07"
s = " JUL "
Case "08"
s = " AUG "
Case "09"
s = " SEPT "
Case "10"
s = " OKT "
Case "11"
s = " NOV "
Case "12"
s = " DEZ "
End Select
.Cells(i, j) = Left(.Cells(i, k), 2) & s & Right(.Cells(i, k), 4)
End If
' .............Der folgende Eintrag ändert die Tage 01 bis 09 nach 1 bis 9 .........
If Left(Range("BT" & i), 1) = "0" Then Range("BT" & i) = Mid(Range("BT" & i), 2, 20)
If Left(.Cells(i, k), 4) = "vor " Then
.Cells(i, j) = "BEF " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 5) = "nach " Then
.Cells(i, j) = "AFT " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 3) = "um " Then
.Cells(i, j) = "ABT " & Right(.Cells(i, k), 4)
End If
End With
End Sub
Es geht aber noch eleganter, komplett ohne If oder Select Case: Code: Sub Datum4()
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("Geburt-Datum")
If Not Spalte1 Is Nothing Then k = Spalte1.Column
Set Spalte2 = .Rows(6).Find("Geburt.-.Datum")
If Not Spalte2 Is Nothing Then j = Spalte2.Column
If Len(.Cells(i, k)) = 4 Then .Cells(i, j) = .Cells(i, k)
If Len(.Cells(i, k)) = 7 Then
.Cells(i, j) = UCase(Format("01." & Left(.Cells(i, k), 2) & ".00", "MMM ")) & Right(.Cells(i, k), 4)
Else
.Cells(i, j) = Left(.Cells(i, k), 2) & UCase(Format("01." & Mid(.Cells(i, k), 4, 2) & ".00", "MMM ")) & Right(.Cells(i, k), 4)
End If
' .............Der folgende Eintrag ändert die Tage 01 bis 09 nach 1 bis 9 .........
If Left(Range("BT" & i), 1) = "0" Then Range("BT" & i) = Mid(Range("BT" & i), 2, 20)
If Left(.Cells(i, k), 4) = "vor " Then
.Cells(i, j) = "BEF " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 5) = "nach " Then
.Cells(i, j) = "AFT " & Right(.Cells(i, k), 4)
End If
If Left(.Cells(i, k), 3) = "um " Then
.Cells(i, j) = "ABT " & Right(.Cells(i, k), 4)
End If
End With
End Sub
Wenn man jetzt noch weiß, dass das deutsche Excel die kurzen Monatsnamen in der siebten benutzerdefinierten Liste hinlegt hat (die englischen sind in Liste 3), dann kann man den länglichen Ausdruck in UCase() noch etwas kürzen: aus UCase(Format("01." & Left(.Cells(i, k), 2) & ".00", "MMM ")) wird dann UCase(arr(--Left(.Cells(i, k), 2)) & " ") bzw. analog dann mit Mid() statt Left(). Und mal so ganz nebenbei bemerkt: ist es nicht etwas inkonsequent, wenn man für die Monatsnamen deutsche Abkürzungen verwendet, aber für die Zeitbereiche englische?
Gruß,
Helmut
Win10 - Office365 / MacOS - Office365
|
Datum kopieren und modifizieren (Ahnenforscher Datum)
