Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
488to492
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
488to492
488to492
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

dtMonat festlegen

dtMonat festlegen
23.09.2004 15:58:32
Ryu_Hoshi
Hallo, ich bins schon wieder!
Ich habe eine Tabelle mit unterschiedlichen Daten. In der Spalte I sind Datumsangaben. Ich möchte dass mir der Macro alle Zeilen löscht ausser mit Datum von letzten Jahr und die übrigen Zeilen Monat für Monat in einen extra Worksheet kopiert werden. So dass z.B. im Worksheet "Januar" nur Daten von Januar sind, im Worksheet "Februar" nur Daten mit Datum von Februar in Spalte I usw. bis alle MOnate verteilt sind.
Ich habe es selber schon versucht. Ich krieg es hin dass 12 worksheets erstellt und richtig benannt werden, aber mit dem Filder und kopieren klappt es noch nicht. Auf jeden Fall muss ich die Variable "dtMonat" richtig definieren, dann könnte es gehen. Ich weiss aber noch nicht wie ich das am besten mache. Wäre toll wenn mir jemand mir da helfen könnte.
So jetzt de Macro:

Private Sub But_letzter_Jahr_Monat_Click()
Dim wksE As Excel.Worksheet
Dim i As Integer
Dim dtJahr As Integer
Dim dtMonat As Integer
Dim r As Byte
Dim c As Byte
Dim j As Integer
Dim wb As Excel.Workbook
Application.ScreenUpdating = False
Set wksE = ThisWorkbook.Worksheets("excel")
dtJahr = Format(Now, "yyyy") - 1
dtMonat = 0
Dim m(11) As String
m(0) = "Januar"
m(1) = "Februar"
m(2) = "März"
m(3) = "April"
m(4) = "Mai"
m(5) = "Juni"
m(6) = "Juli"
m(7) = "August"
m(8) = "September"
m(9) = "Oktober"
m(10) = "November"
m(11) = "Dezember"
Set wb = ThisWorkbook
For j = 0 To UBound(m())
Worksheets.Add After:=Worksheets(Worksheets.Count)
ThisWorkbook.ActiveSheet.Name = m(j)
Next j
'PROBLEM: dtMonat FESTLEGEN/wann welcher monat
With wksE
.Activate
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Month(wksE.Cells(i, 9)) <> dtMonat Or Year(wksE.Cells(i, 9)) <> dtJahr Then
.Activate
.Range(Cells(i, 1), Cells(i, 9)).Copy wb.Sheets(m(Month(.Cells(i, 9)) - 1)).Cells(i, 1)
End If
Next
End With
Set wksE = Nothing
Application.ScreenUpdating = True
End Sub

mit freundlichen Grüssen
Waldemar

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: dtMonat festlegen
23.09.2004 16:34:36
Gert
Hallo Waldemar,
die "Monate" gibst Du als "String" (Text) und nicht als Zahl an.
Dim dtMonat As String
Vielleicht war das alles.
mfg
Gert
AW: dtMonat festlegen
Ryu_Hoshi
Hallo Gert!
Ich konnte das Problem mit Hilfe anderer lösen. Ich poste die Lösung hier rein falls jemand ein ähnliches oder gleiches Problem haben wird.
Option Explicit
Private Const TBL = "Excel"
Private Const STARTZELLE = "I1"
Private Const LAST_COL = 12
---------------------------------------------------------------------------------------

Private Sub But_letzter_Jahr_Monat_Click()
Dim Ws As Worksheet, Ws1 As Worksheet
Dim Mt(), i&
On Error Resume Next
Mt = Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", _
"September", "Oktober", "November", "Dezember")
' Sheets herstellen
For i = 0 To UBound(Mt)
Set Ws = Worksheets(Mt(i))
If Err.Number <> 0 Then _
Set Ws = Sheets.Add(After:=Worksheets(Worksheets.Count)): Ws.Name = Mt(i)
Err.Clear
Next i
Set Ws = Worksheets(TBL)
If Err.Number <> 0 Then _
MsgBox "Blatt " & TBL & " nicht gefunden .. ", vbCritical: Exit Sub
' Einsortieren
With Ws
For i = 1 To .Cells(Rows.Count, Range(STARTZELLE).Column).End(xlUp).Row
' handelt es sich überhaupt um ein Datum ?
If IsDate(.Cells(i, Range(STARTZELLE).Column).Value) Then
'kopieren der Daten auf das entsprechende Monatsblatt
' ( Zeile ins Monatsblatt )
'Und jetzt kommt die Jahresabfrage
If Year(.Cells(i, Range(STARTZELLE).Column).Value) = Year(Date) - 1 Then
Set Ws1 = Worksheets(Mt(Month(.Cells(i, Range(STARTZELLE).Column).Value) - 1))
' kopieren der Zeile in das entsprechende Blatt in die erste freie Zeile
.Range(.Cells(i, 1), .Cells(i, LAST_COL)).Copy Destination:= _
Ws1.Cells(Ws1.Cells(Rows.Count, Range(STARTZELLE).Column).End(xlUp).Row + 1, 1)
' loeschen der Zeile
.Range(.Cells(i, 1), .Cells(i, LAST_COL)).ClearContents
End If
End If
Next i
End With
Set Ws = Nothing: Erase Mt: Set Ws1 = Nothing
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige