AW: Einfügen per Makro Problem
09.01.2020 17:45:14
fcs
Hallo Tobias,
genaue Hilfe ist ja immer nur möglich, wenn die Beispiel-Datei die Realität genau wiederspiegelt.
In deiner Beispieldatei sind in den Problemzellen jedefals 2 Leerzeichen hinter den Zahlen und keine Tabs.
Ich hab mein Makro angepasst, so dass nir in den Spalten P bis AI die Zahlenumwandlung erfolgt.
Zusätzlich wird während der Ausführung des Makros zeitweise die Bildschirmaktualisierung deaktiviert und der Berechnungsmodus auf manuell gesetzt.
Du hast in deiner Beispieldatei auch eine Spalte mit Datums/Zeit-Werten. Diese stehen als Text in den Zellen und sollten ggf. in Excel-Zeitwerte konvertiert werden.
LG
Fanz
hier das angepasste Makro mit Kommentaren zum besseren Verständmis für dich.
Sub Maktest()
Dim wks As Worksheet
Dim rngZiel As Range
Dim Zeile As Long, Zeile_L As Long
Dim Spalte_1 As Long, Spalte_L As Long
Dim strText As String
Dim StatusCalc As Long
Set wks = ActiveSheet
With wks
'letzte Zelle mit Inhalt in Spalte C ermitteln
Set rngZiel = .Range("C3000").End(xlUp)
'nächste freie Zeile in Spalte C setzen = 1 Zelle unterhalb
Set rngZiel = rngZiel.Offset(1, 0)
'freie Zelle selektieren
rngZiel.Select
'Nr. der 1. Einfügezeile merken
Zeile = rngZiel.Row
'Inhalt aus Zwischenablage einfügen
ActiveSheet.PasteSpecial
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation 'Berechnungsmodus merken
.Calculation = xlCalculationManual
End With
'1. eingefügte Zeile löschen
.Rows(Zeile).Delete Shift:=xlShiftUp
'letzte benutzte Zeile nach dem Einfügen ermitteln
Zeile_L = .UsedRange.Row + .UsedRange.Rows.Count - 1
'neue letzte Zeile mit Inhalt in Spalte C
Zeile_L = .Cells(.Rows.Count, 3).End(xlUp).Row
'in Spalten P bis AI die Zahlen mit Text (Leerzeichen oder Tabs) in Zahlen umwandeln
Spalte_1 = .Range("P1").Column
Spalte_L = .Range("AI1").Column
For Each rngZiel In .Range(.Cells(Zeile, Spalte_1), .Cells(Zeile_L, Spalte_L)).Cells
strText = rngZiel.Text
'Tab-Zeichen im Zellinhalt entfernen - durch Leerstring ersetzen
strText = Replace(strText, Chr(9), "")
'Leerzeichen am Anfang/Ende des Textes entfernen
strText = Trim(strText)
'ggf. Ziffernfolge in Zahl umwandeln und in Zelle eintragen.
If IsNumeric(strText) Then rngZiel.Value = CDbl(strText)
Next
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub