AW: PQ behindert einen da nur
02.02.2022 01:10:42
Julian
Hallo zusammen,
vielen Dank für eure Rückmeldung. Habe dies verarbeitet und habe dazu noch ein paar Fragen:
1. Wie fügt Ihr hier im Forum die Prozeduren ein, ohne diese als Text einzufügen? Sodass diese in einem separaten Kasten sind?
2. Folgende Prozedur habe ich geschrieben, bzw. teils aus dem Forum mir zusammen gesucht. Aber es sind noch Fehler enthalten. HILFE
Sub UebertragungDaten()
Dim letzteZeile As Integer
Dim iRow As Integer
Dim iRowA As Integer
iRow = Cells(Rows.Count, 1).End(xlUp).Row
letzteZeile = Tabelle8.UsedRange.Rows.Count
Tabelle8.Range("T2:T" & letzteZeile).Copy ' Verwendungszweck wird übertragen, save!
With Tabelle7
With .Range("B" & .UsedRange.Rows.Count + 1)
.PasteSpecial Paste:=xlPasteValues
End With
End With
' Fehler: Wird nicht als Datum angezeit, obwohl Zellen als Datum Formatiert?!?!
Tabelle8.Range("B2:B" & letzteZeile).Copy Destination:=Tabelle7.Range("A" & iRow + 1) ' Datum wird übertragen, aktuell kann nur durch Sub "TextInDatum" umformatiert werden
With Tabelle7 ' Wert Ausgabe wird übertragen --> muss noch als Wert eingefügt werden. Damit beim Wert stehen bleibt beim Import der nächsten Daten
With .Range("E" & iRow + 1).Formula = _
"=(0>SparkasseImport!O2)*SparkasseImport!O2"
.Range("E" & iRow + 1)
.NumberFormat = "0.00;-0.00;"
.PasteSpecial Paste:=xlPasteValues
End With
End With
With Tabelle7 ' Wert Einnahme wird übertragen --> muss noch als Wert eingefügt werden. Damit beim Wert stehen bleibt beim Import der nächsten Daten
.Range("F" & iRow + 1).Formula = _
"=(SparkasseImport!O2>0)*SparkasseImport!O2"
.Range("F" & iRow + 1).NumberFormat = "0.00;-0.00;"
.PasteSpecial = xlPasteValues
End With
Tabelle7.Range("E" & iRow).FillDown
' Fehler: Woran liegt es, dass die Formel nicht runter gezogen wird?
End Sub
Sub TextInDatum()
' Unpraktisch! Extra Formel zum umformatieren, geht das nicht leichter?
Dim vntDaten As Variant
Dim lngZeile As Long
Dim lngSpalte As Long
Dim strFehler As String
Dim rngBereiche As Range
Dim rngFehler As Range
Dim rng As Range
Dim iRow As Integer
iRow = Cells(Rows.Count, 1).End(xlUp).Row
Tabelle7.Range("A2:A" & iRow).Select
vntDaten = Selection
For lngSpalte = 1 To UBound(vntDaten, 2)
For lngZeile = 1 To UBound(vntDaten, 1)
If IsDate(vntDaten(lngZeile, lngSpalte)) Then
vntDaten(lngZeile, lngSpalte) = DateValue(vntDaten(lngZeile, lngSpalte))
If rngBereiche Is Nothing Then
Set rngBereiche = Cells(Selection.Row, Selection.Column) _
.Offset(lngZeile - 1, lngSpalte - 1)
Else
Set rngBereiche = Union(rngBereiche, Cells(Selection.Row, Selection.Column) _
.Offset(lngZeile - 1, lngSpalte - 1))
End If
Else
If rngFehler Is Nothing Then
Set rngFehler = Cells(Selection.Row, Selection.Column) _
.Offset(lngZeile - 1, lngSpalte - 1)
Else
Set rngFehler = Union(rngFehler, Cells(Selection.Row, Selection.Column) _
.Offset(lngZeile - 1, lngSpalte - 1))
End If
strFehler = "Die markierten Zellen enthalten keine Datumsangaben " _
& " und wurden daher nicht verändert." & vbCrLf & vbCrLf & _
"Es können auch mehrere getrennte Zellen markiert sein. Verwenden Sie " _
& "die Tabulatortaste, um von einer Zelle zur nächsten zu gelangen, ohne " _
& "die Markierung aufzuheben."
End If
Next 'lngZeile
Next 'lngSpalte
If strFehler = "" Then
With Selection
.NumberFormat = "dd.MM.yyyy"
.Value = vntDaten
End With
Else
For Each rng In rngBereiche.Areas
rng.NumberFormat = "dd.MM.yyyy"
Next 'rng
Selection = vntDaten
rngFehler.Select
MsgBox strFehler, vbExclamation
End If
Set rng = Nothing
Set rngFehler = Nothing
Set rngBereiche = Nothing
End Sub