AW: Daten von eine in die andere Tabelle übertragen
21.08.2010 19:08:03
eine
Hallo Achim,
mit den Daten in deiner Beispiel-Datei hatte ich unter Excel 2007 keine Probleme. Anfangs- und Endedatum spielen keine Rolle. Die Anzahl Tage ist nur durch die max. Anzahl Spalten des Tabellenblatts begrenzt.
Kann es sein, dass die Datumsangeben als Text in den Zellen stehen und nicht als Excel-Datum/Zahl. Dies passiert häufig wenn Daten importiert werden. Dann gibt es Probleme im Makro rund um die Daumsangaben.
Falls ja, dann füge nachfolgende Text-Datums-Konversion für die Spalte F der Disposition ein.
Die einfache Variante zur Konversion sollte in deinem Fall reichen.
Gruß
Franz
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