Makro hat Probleme mit negativen Zahlen
28.10.2019 14:27:53
Christian
ich habe ein Problem mit nachfolgendem Makro:
seit in Spalte F nicht nur Daten im Format TT.MM.JJJJ stehen, sondern auch negative Zahlen, bekomme ich einen Laufzeitfehler 1004 und beim debuggen wird die Zeile
.Range("E2:F" & loLetzte).Formula = .Range("E2:F" & loLetzte).Value
markiert.
Ich hatte das Problem mit fast demselben Makro schonmal, nur leider habe ich die Datei in der das Problem gelöst war, versehentlich gelöscht und meine Sicherheitskopie hatte noch das alte Makro. Jetzt habe ich es leider nicht mehr geschafft, das was damals im alten Thread besprochen wurde, auf das jetzige (leicht geänderte) Makro anzuwenden und brauche daher nochmal eure Hilfe.
Hier noch der alte Thread
https://www.herber.de/forum/cgi-bin/callthread.pl?index=1709572
wie gesagt das Problem wird erneut daran liegen, dass Daten und negative Zahlen in Spalte F vermischt sind.
Danke nochmals für eure Hilfe
Christian
Sub Makro3()
Dim loLetzte As Long, j As Long, x As Long, lC As Long
Application.ScreenUpdating = False
With Worksheets("Ergebnis")
loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("B1:C1").Copy .Range("B1:C" & loLetzte)
.Range("B2:C" & loLetzte).Copy
.Range("B2:C" & loLetzte).PasteSpecial xlPasteValues
.Range("E1:F1").Copy .Range("E2:F" & loLetzte)
.Range("E2:F" & loLetzte).Formula = .Range("E2:F" & loLetzte).Value
.Range("K1") = "Formel" 'Zeile 1 markieren!!
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C1:C" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("F1:F" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:K1" & loLetzte)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Zeile der Markierung in Spalte l suchen
x = .Cells(Rows.Count, 11).End(xlUp).Row
'Formeln ggf. in Zeile1 zurück kopieren
If x > 1 Then
.Cells(x, 2).Resize(1, 2).Copy .Range("B1")
.Cells(x, 5).Resize(1, 6).Copy .Range("E1")
.Cells(x, 5).Copy .Range("E1")
.Rows(x).Value = .Rows(x).Value
End If
.Range("G1:J1").Copy .Range("G2:J" & loLetzte)
.Range("G2:J" & loLetzte).Copy
.Range("G2:J" & loLetzte).PasteSpecial xlPasteValues
.Cells(x, 11) = Empty 'markierung löschen
.Range("E2").Select
End With
Application.CutCopyMode = False
End Sub
Anzeige