Ich habe zwei Sheets:
1. Disposition
2. NMPKurz
Ich möchte die Daten aus der Disposition in NMPKurz in einer anderen Anordnung übertragen.
Hierzu habe ich eine Beispielsdatei eingestellt.
https://www.herber.de/bbs/user/71160.xls
Danke Achim
Sub Daten_umgruppieren()
Dim StatusCalc
'Makrobremsen lösen
With Application
.EnableEvents = False
StatusCalc = .Application.Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
On Error GoTo Fehler
Set wksDispo = Worksheets("Disposition")
'Blatt zum Umgruppieren setzen
Set wksNMP = Worksheets("NMPkurz")
sMsgTitel = "Daten umgruppieren"
'DatumKonvertieren
With wksDispo
Call TextZuDatum(Zellbereich:=.Range(.Cells(Zeile_1, 6), _
.Cells(.Rows.Count, 6).End(xlUp)))
' Call TextZuDatum2(Zellbereich:=.Range(.Cells(Zeile_1, 6), _
.Cells(.Rows.Count, 6).End(xlUp)), Pos1J:=7, Len_J:=4, _
Pos1M:=4, Len_M:=2, Pos1T:=1, Len_T:=2)
End With
Call AltdatenLoeschen
If Titelzeilen = False Then GoTo Beenden
Call DatenUbertragen
wksNMP.Activate
Range("E3").Select
'Fehlerbehandlung
Fehler:
With Err
Select Case .Number
Case 0 'kein Fehler
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Beenden:
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
End With
End Sub
Sub TextZuDatum(Zellbereich As Range)
Dim Zelle As Range
'Wandelt als Datum interpretierbare Texte in Zellen in Excel-Datum um.
'Vorsicht bei Datum im US-Format!!
'Funktionioniert zuverlässig nur wenn Datumsschreibweise wie Systemeinstellung oder _
im ISO-Format JJJJ-MM-DD
With Zellbereich
.NumberFormat = "General"
For Each Zelle In .Cells
If IsDate(Zelle.Text) Then
Zelle.Value = CDate(Zelle.Text)
End If
Next
End With
End Sub
Sub TextZuDatum2(Zellbereich As Range, Pos1J&, Len_J&, Pos1M&, Len_M&, Pos1T&, Len_T&)
Dim Zelle As Range, sJahr$, sMonat$, sTag$
'Wandelt als Datum interpretierbare Texte in Zellen in Excel-Datum um.
'Position und Länge von Jahr,Monat,Tag im Textstring muss immer gleich sein
'Textteile werden ins ISO-Format JJJJ-MM-DD umgesetzt, dann konvertiert
With Zellbereich
.NumberFormat = "General"
For Each Zelle In .Cells
sJahr = Mid(Zelle.Text, Pos1J, Len_J)
sMonat = Mid(Zelle.Text, Pos1M, Len_M)
sTag = Mid(Zelle.Text, Pos1T, Len_T)
If IsDate(sJahr & "-" & sMonat & "-" & sTag) Then
Zelle.Value = CDate(sJahr & "-" & sMonat & "-" & sTag)
End If
Next
End With
End Sub