PDA

Vollständige Version anzeigen : Typen unverträglich


Franki137
24.09.2016, 19:37
Hallo zusammen,

ich habe bei der VBA-Programmierung folgendes Problem:

Folgendes Makro liest aus einer Spalte mit Datum (TTMMJJ)die Jahreszahlen aus.

Wenn diese mit dem aktuellen Jahr übereinstimmen, werden sie auf ein zweites

Tabellenblatt kopiert.

Leider bringt er für die Variable "D" ständig die Fehlermeldung "Typen

unverträglich".

"D" soll die ausgelesene Jahreszahl der aktiven Zelle ausgeben.

Wenn ich die Prozedur in Einzelschritten durchlaufe, läuft der Code komischerweise.

Bitte helft mir bei dem Problem.

Muss ich "D" eine anderen Typ bedaten oder woran liegts ?

Hier das Makro:

Option Explicit
Dim i As Integer
Dim LaufzBeginn As Range
Dim LaufzEnde As Range
Dim Jahr
Dim D As Integer
Dim Zelle As Object
Dim Z As Integer
Dim s As Integer
Dim iAnz As Integer
Const Blatt1 = "Grunddaten"
Const Blatt2 = "Test"

Sub Datum_kopiern()

Sheets("Grunddaten").Select

i = Cells(Rows.Count, 5).End(xlUp).Row
i = i - 2

MsgBox ("Die letzte beschriebene Spalte ist Nr. " & i)

Set LaufzBeginn = Range(Cells(2, 5), Cells(i, 5))
Set LaufzEnde = Range(Cells(2, 6), Cells(i, 6))


Sheets("Grunddaten").Select
Sheets("Grunddaten").Range("3:1").Select
'Sheets("Test").Range("A1").Select
Application.ScreenUpdating = False
Sheets(Blatt1).Activate
LaufzBeginn.Select
iAnz = 0
s = 0
Z = 1

Do Until s = i

Set Zelle = ActiveCell
D = Year(Zelle)
Jahr = Year(Date)
If D < Jahr Then
End If
If D > Jahr Then
End If
If D = Jahr = True Then
Zelle.Copy
Sheets(Blatt2).Activate
Sheets(Blatt2).Cells(Z, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Z = Z + 1
Sheets(Blatt1).Select
End If
ActiveCell.Offset(1, 0).Select
Loop

Application.CutCopyMode = False
Application.ScreenUpdating = True



'MsgBox ("Es wurden " & iAnz & " Zellen übertragen.")

MsgBox ("Test erfolgreich")


End Sub



Danke für Eure Zeit und Mühe !!!

Gruß Frank.

Storax
24.09.2016, 19:48
Beispieldatei?!

Franki137
24.09.2016, 19:59
Kommt sofort !

Franki137
24.09.2016, 20:01
Hallo zusammen,

hier noch die Datei zum Makro.

Danke !

Gruß Frank.

Storax
24.09.2016, 20:19
Dein Code läuft auch im Debugger nicht durch, nur die ersten Durchläufe. Du hast eine Endlos-Schleife produziert, Deine Zählvariable s bleibt immer 0. Du läufst auf eine leere Zelle, da steigt Dein Code dann aus

Der ganze Code ist diplomatisch gesagt verbesserungswürdig. Die Select und Activate sind überflüssig. Mit Activecell zu arbeiten ist ungeschickt. Usw usf.

Franki137
24.09.2016, 20:24
Hallo Storax,

ach Mist, ich hab das falsche Modul erwischt !!!

Das hier müsste es sein:

Option Explicit
Dim i As Integer
Dim LaufzBeginn As Range
Dim LaufzEnde As Range
Dim Jahr
Dim D As Integer
Dim Zelle As Object
Dim Z As Integer
Dim s As Integer
Dim iAnz As Integer
Const Blatt1 = "Grunddaten"
Const Blatt2 = "Test"
Sub Datum_kopiern()

Sheets("Grunddaten").Select

i = Cells(Rows.Count, 5).End(xlUp).Row
i = i - 2

MsgBox ("Die letzte beschriebene Spalte ist Nr. " & i)

Set LaufzBeginn = Range(Cells(2, 5), Cells(i, 5))
Set LaufzEnde = Range(Cells(2, 6), Cells(i, 6))


Sheets("Grunddaten").Select
Sheets("Grunddaten").Range("3:1").Select
'Sheets("Test").Range("A1").Select
Application.ScreenUpdating = False
Sheets(Blatt1).Activate
LaufzBeginn.Select
iAnz = 0
s = 0
Z = 1

Do Until s = i

Set Zelle = ActiveCell
D = Year(Zelle)
Jahr = Year(Date)
If D < Jahr Then
End If
If D > Jahr Then
End If
If D = Jahr = True Then
Zelle.Copy
Sheets(Blatt2).Activate
Sheets(Blatt2).Cells(Z, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Z = Z + 1
Sheets(Blatt1).Select
End If
ActiveCell.Offset(1, 0).Select
Loop

Application.CutCopyMode = False
Application.ScreenUpdating = True



'MsgBox ("Es wurden " & iAnz & " Zellen übertragen.")

MsgBox ("Test erfolgreich")


End Sub








Dank Dir !

Storax
24.09.2016, 20:37
Das ist egal! Warum lädst Du nicht die Beispieldatei mit Code hoch! :kopfschüttel:
Ich habe jetzt Deine Beispieldatei mal hergenommen und folgenden Beispielcode für Dich geschrieben. Kein Select, kein Activate
Option Explicit

Const COL_DATEN = 5
Const SHEET_GRUNDDATEN = "Grunddaten"
Const SHEET_TEST = "Test"
Const RG_DATA = "E2:E46"
Sub CopyToTest()

Dim wksGrunddaten As Worksheet
Dim wksTest As Worksheet
Dim rgData As Range, sngCell As Range
Dim curRow As Long

Set wksGrunddaten = Sheets(SHEET_GRUNDDATEN)
Set wksTest = Sheets(SHEET_TEST)
Set rgData = wksGrunddaten.Range(RG_DATA)

curRow = 1
For Each sngCell In rgData
If Year(sngCell.Value) = Year(Date) Then
wksTest.Cells(curRow, 1).Value = sngCell.Value
curRow = curRow + 1
End If
Next

End Sub


Und wieso falsches Modul, ist doch der gleiche Code.
Und was soll dieser Code bezwecken?
If D < Jahr Then
End If
If D > Jahr Then
End If

Franki137
24.09.2016, 20:49
Soll bewirken, wenn die aus der jeweiligen Zelle ausgelesene Jahreszahl nicht dem aktuellem Jahr entspricht, dann nicht rüberkopieren.

Funzt super.

Oh je, da hab ich noch ne Menge an Lehrgeld vor mir !!!

Storax
24.09.2016, 20:51
Soll bewirken, wenn die aus der jeweiligen Zelle ausgelesene Jahreszahl nicht dem aktuellem Jahr entspricht, dann nicht rüberkopieren.Diese If Statements sind überflüssig, das war keine Verständnisfrage von mir, sondern eine für Dich.

Franki137
28.09.2016, 19:25
Hallo Storax,

Code funzt jetzt.

Danke nochmal für die Tips und den Code ! :)