habe ein kniffliges Problem. Wie ist es möglich in einem VBA-Code englische Monatsbezeichnungen wie z.B. Oct-05, in ein stinknormales Okt. 05 oder Okt 05 umzuwandeln, ohne die Ländereinstellung im System zu verändern.
Horst
Option Explicit
Option Base 1
Sub Uebersetzen() ' Kürzel von Englisch nach Deutsch übersetzen
' Wichtig: 'Option Base 1' - muss eingefügt werden!
'
' es werden zwei Varianten angeboten: Einmal als Select Case für
' Spalte D & Variante zwei als kürzere Array-Lösung für Spalte E
'
Dim iZeile As Integer ' For/Next für die lfd. Zeile
Dim iPosition As Integer ' Position im String
Dim iIndx As Integer ' For/Next Index
Dim aMonatE As Variant ' die Monatsnamen englisch
Dim aMonatD As Variant ' die Monatsnamen deutsch
Dim sMonat As String * 3 ' Zwischenbereich für engl. Monat
Application.ScreenUpdating = False
Range("D1:E15").ClearContents
' Monat nach Spalte D übersetzen
For iZeile = 1 To 12
Select Case Left(LCase(Range("C" & iZeile).Value), 3)
Case "jan": Range("D" & iZeile).Value = "Jan"
Case "feb": Range("D" & iZeile).Value = "Feb"
Case "mar": Range("D" & iZeile).Value = "Mrz"
Case "apr": Range("D" & iZeile).Value = "Apr"
Case "may": Range("D" & iZeile).Value = "Mai"
Case "jun": Range("D" & iZeile).Value = "Jun"
Case "jul": Range("D" & iZeile).Value = "Jul"
Case "aug": Range("D" & iZeile).Value = "Aug"
Case "sep": Range("D" & iZeile).Value = "Sep"
Case "oct": Range("D" & iZeile).Value = "Okt"
Case "nov": Range("D" & iZeile).Value = "Nov"
Case "dec": Range("D" & iZeile).Value = "Dez"
End Select
Range("D" & iZeile).Value = Range("D" & iZeile).Value & "-" & Right(Year(Date), 2)
Next iZeile
' CalenderYear übersetzen
If LCase(Left(Range("C13").Value, 3)) = "cal" Then
Range("D13").Value = "KJ " & Mid(Range("C13").Value, 5, 2)
End If
' Datum in Form TT-Mmm-JJJ übersetzen
aMonatE = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", _
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
aMonatD = Array("Jan", "Feb", "Mrz", "Apr", "Mai", "Jun", _
"Jul", "Aug", "Sep", "Okt", "Nov", "Dez")
For iIndx = 1 To 12 ' aMonatE abarbeiten
sMonat = LCase(aMonatE(iIndx)) ' englische Monat nach Zwischenbereich
iPosition = InStr(LCase(Range("C14").Value), sMonat)
If iPosition > 0 Then ' gefunden, wenn größer Null
Range("D14").Value = Left(Range("C14").Value, 2) & ". " & _
aMonatD(iIndx) & ". " & Right(Range("C14").Value, 2)
Exit For ' For/Next verlassen
End If
Next iIndx
' Quartal übersetzen
iPosition = InStr(UCase(Range("C15").Value), "Q")
If iPosition > 0 Then
Range("D15").Value = "Quartal " & Mid(Range("C15").Value, iPosition + 1, 1) _
& " in " & Mid(Range("C15").Value, iPosition + 3, 2)
End If
' Monat nach Spalte E übersetzen
For iZeile = 1 To 12
For iIndx = 1 To 12 ' aMonatE abarbeiten
sMonat = LCase(aMonatE(iIndx)) ' englische Monat nach Zwischenbereich
iPosition = InStr(LCase(Range("C" & iZeile).Value), sMonat)
If iPosition > 0 Then ' gefunden, wenn größer Null
Range("E" & iZeile).Value = aMonatD(iIndx) & "-" & Right(Year(Date), 2)
Exit For ' For/Next verlassen
End If
Next iIndx
Next iZeile
Application.ScreenUpdating = True
Viele Grüße Peter
Das Forum lebt auch von den Rückmeldungen.