Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 15:16:20
VBA Suchen, Kopieren, Einfügen
18.04.2024 15:16:07
Verschieben von Daten um bestimmte Zeilen nach unten
18.04.2024 15:13:44
Text ans untere Ende der Seite verschieben
18.04.2024 15:00:48
Datum als Datum sehen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
648to652
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
648to652
648to652
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Archiv erstellen

Archiv erstellen
05.08.2005 17:42:24
SusanneNr.1000
Hallo,
ich bin noch relativer Anfänger in VBA und habe mal wieder eine Frage an die Profis ...
Ich habe ein Tabellenblatt mit sehr vielen Einträgen und die Tabelle hat 7 Spalten. In Spalte D befindet sich jeweils ein Datumswert. Nun habe ich ein weiteres Tabellenblatt sozusagen als Archiv angelegt. Ich möchte nun ein Makro schreiben, das nach Knopfdruck alle Datumswerte in Spalte D mit dem aktuellen Datum vergleicht und falls das Datum älter als heute ist, soll die gesamte Zeile in der das Datum steht ins Archiv geschoben werden. Das bedeutet natürlich das das Makro erst einmal die erste leere Zeile im Archivtabellenblatt ermitteln muss und dann die Zeile in der ursprünglichen Tabelle ausschneiden und dort einfügen soll ...
Könnte mir jemand eventuell mit einem Lösungsansatz helfen, das wäre wirklich toll! Vielen Dank im Voraus!
Gruß Susanne

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Archiv erstellen
05.08.2005 17:58:38
Matthias
Hallo Susanne,
Der erste Blatt heißt hier "Liste", das andere "Archiv". Bei Bedarf anpassen.

Sub Archivieren()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim z As Long, lz As Long, i As Long
Set Sh1 = Sheets("Liste")
Set Sh2 = Sheets("Archiv")
lz = Sh1.Range("A65536").End(xlUp).Row
For i = lz To 2 Step -1
With Sh1
If .Cells(i, 4).Value < Date Then
z = Sh2.Range("A65536").End(xlUp).Row + 1
.Cells(i, 5).EntireRow.Copy Destination:=Sh2.Cells(z, 1).EntireRow
.Cells(i, 5).EntireRow.Delete
End If
End With
Next i
End Sub

Gruß Matthias
AW: Archiv erstellen
05.08.2005 19:08:49
SusanneNr.1000
Hallo Matthias,
Danke für die schnelle Antwort! Leider funktioniert das Makro so nicht bei mir ... Außer das die Daten alle wie wild flackern und Excel sich aufhängt passiert leider nichts ... Könnte das eventuell daran liegen das die Überschrift kein Datumsformat hat, sondern das Wort "Datum" enthält? Oder was läuft da falsch?
Liebe Grüße eine ratlose Susanne ...
Anzeige
AW: Archiv erstellen
05.08.2005 20:03:11
Matthias
Hallo Susanne,
dass die Daten flackern, kann ich mir beim besten Willen nicht vorstellen...
Lade doch mal eine Mustertabelle hoch, denn bei mir läuft der Code einwandfrei.
Gruß Matthias
AW: Archiv erstellen
06.08.2005 09:09:29
SusanneNr.1000
Hallo Matthias,
ich habe gerade eine Mustertabelle gebastelt und habe dann aber festgestellt das es bei dieser komischerweise klappt ... Habe dann noch alles mögliche probiert damit es bei meiner eigentlichen Tabelle auch läuft, aber da geht es komischerweise nicht !?! Unten steht nur die ganze Zeit "zellen werden berechnet". Ich habe zwar ca. 1300 Datensätze, aber ich kann mir trotzdem nicht vorstellen dass es über 10 Minuten dauern soll (so langsam ist mein Rechner nun auch nicht).
Liebe Grüße Susanne (die nun immer ratloser ist)
Anzeige
AW: Archiv erstellen
06.08.2005 09:47:57
Matthias
Hallo Susanne,
hast du denn Formeln in der Tabelle?
Wenn da dann Zeilen gelöscht werden, geht da die Konsistenz der Tabelle vielleicht verloren?
Man könnte ja auch nur die Werte (ohne Formeln) ins Archivblatt schreiben.
Gruß Matthias
AW: Archiv erstellen
06.08.2005 13:12:46
SusanneNr.1000
Hallo Matthias,
Das könnte wirklich die Lösung des Problems sein, denn ich habe ein Makro geschrieben, das sich allerdings nur auf die Originalliste bezieht und bei Änderung in irgendeiner Zelle ín der gleichen Zeile in Spalte A das Datum von heute einfügt ... und noch ein paar andere Formeln (die Löschung der Zeile hat aber keinen Einflusss). Wie mache ich es denn, das nur die reinen Werte ins Archiv übernommen werden?
Liebe Grüße Susanne
Anzeige
AW: Archiv erstellen
06.08.2005 13:30:52
Matthias
Hallo Susanne,
...ich habe ein Makro geschrieben, das sich allerdings nur auf die Originalliste bezieht und bei Änderung in irgendeiner Zelle ín der gleichen Zeile in Spalte A das Datum von heute einfügt ...
Das klingt nach Ereignismakro Worksheet_Change()... Das sollte man währen des Archivierens unbedingt abschalten (EnableEvents).

Sub Archivieren()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim z As Long, lz As Long, i As Long
Set Sh1 = Sheets("Liste")
Set Sh2 = Sheets("Archiv")
lz = Sh1.Range("A65536").End(xlUp).Row
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For i = lz To 2 Step -1
With Sh1
If .Cells(i, 4).Value < Date Then
z = Sh2.Range("A65536").End(xlUp).Row + 1
.Cells(i, 5).EntireRow.Copy
Sh2.Cells(z, 1).EntireRow.PasteSpecial xlPasteValuesAndNumberFormats
.Cells(i, 5).EntireRow.Delete
End If
End With
Next i
With Application
.EnableEvents = True
.ScreenUpdating = True
.CutCopyMode = False
End With
End Sub

Vielleicht klappt es ja so.
Gruß Matthias
Anzeige
AW: Archiv erstellen
06.08.2005 19:44:53
SusanneNr.1000
Hallo Matthias,
vielen Dank für deine Geduld und Hilfsbereitschaft. Es ist mir schon fast peinlich, aber es funkioniert immer noch nicht und ich habe überhaupt keine Idee mehr woran das liegen könnte ...
Die Meldung "Zellen werden berechnet" ist zwar weg und es flackert auch nichts mehr, aber die Sanduhr taucht auf und verschwindet auch nicht wieder, weiter passiert leider nichts ... Wenn keiner mehr eine Idee hat woran es liegen sollte, werde ich wohl auf mein Makro verzichten und weiter alles per Hand machen :-(
Liebe Grüße Susanne
Liebe Grüße
AW: Archiv erstellen
06.08.2005 20:02:23
Leo
Hi,
wenn deine Excelversion wirklich 2000 ist, gab es da nocht nicht
PasteSpecial xlPasteValuesAndNumberFormats
mfg Leo
Anzeige
AW: Archiv erstellen
06.08.2005 20:12:24
SusanneNr.1000
Danke Leo für den Hinweis, ich habe gerade noch einmal nachgeschaut und festgestellt, dass es in Wirklichkeit auch Office XP ist (habe mich leider vertan), da hätte das dann aber doch eigentlich funktionieren müssen, oder?
Gruß Susanne
AW: Archiv erstellen
06.08.2005 20:12:11
Matthias
Hallo Susanne,
poste doch mal den Code, der im Tabellenmodul seht.
Gruß Matthias
AW: Archiv erstellen
06.08.2005 20:27:46
SusanneNr.1000 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strInput As String
Dim nCells   As Long
'Wenn in Spalte B 'was geändert wird...
If Not Application.Intersect(Columns(2), _
Range(Target.Address)) Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
strInput = Trim$(Target.Value)
If Len(strInput) > 0 Then
nCells = WorksheetFunction.CountIf(Columns(2), strInput)
If nCells > 1 Then
MsgBox "Den Wert " & strInput & " gibt es bereits !!!"
'Die Zelle wieder aktivieren
Target.Activate
Dim strSuchfaktor As String
strSuchfaktor = ActiveCell.Value
Selection.AutoFilter Field:=2, Criteria1:=strSuchfaktor
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=3
ActiveWindow.ScrollRow = 1
End If
End If
On Error GoTo 0
Application.EnableEvents = True
End If
On Error Resume Next
If Target.Column = 1 Then Exit Sub
If Target.Offset(0, 1 - Target.Column) <> "" Then Exit Sub
On Error Resume Next
Target.Offset(0, 1 - Target.Column) = Date
On Error GoTo 0
End Sub

Anzeige
AW: Archiv erstellen
06.08.2005 20:37:39
Matthias
Hallo Susanne,
hmmm, naja, aber wenn die Ereignisse abgeschaltet sind (.EnableEvents = False), wird das ja gar nicht ausgeführt.
Eine Idee hab ich noch, weil es so lange dauert...

Sub Archivieren()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim z As Long, lz As Long, i As Long
Set Sh1 = Sheets("Liste")
Set Sh2 = Sheets("Archiv")
lz = Sh1.Range("A65536").End(xlUp).Row
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual ' <<<<<< NEU >>>>>>>>>
End With
For i = lz To 2 Step -1
With Sh1
If .Cells(i, 4).Value < Date Then
z = Sh2.Range("A65536").End(xlUp).Row + 1
.Cells(i, 5).EntireRow.Copy
Sh2.Cells(z, 1).EntireRow.PasteSpecial xlPasteValuesAndNumberFormats
.Cells(i, 5).EntireRow.Delete
End If
End With
Next i
With Application
.EnableEvents = True
.ScreenUpdating = True
.CutCopyMode = False
.Calculation = xlCalculationAutomatic ' <<<<<< NEU >>>>>>>>>
End With
End Sub

...nämlich die automatische Berechnung vor der Schleife ab- und dann wieder einschalten.
Und dann hab ich noch nicht getestet, was der eingeschaltete Autofilter machen könnte - da kann ich mir aber keine Fehlerursache vorstellen...
Du könntest ja auch mal die ganze Mappe, evtl. mit verkürzten/geänderten Daten hochladen.
Viel Erfolg,
Matthias
Anzeige
AW: Archiv erstellen
07.08.2005 09:48:17
SusanneNr.1000
Hallo Matthias,
es geht leider immer noch nicht, aber bei der Mustertabelle bekomme ich die Fehlermeldung "Laufzeitfehler ´9´: Index außerhalb des gültigen Bereichs". Könnte das auch ein Grund für das Nichtfunktionieren bei der eigentlichen Tabelle sein?
Gruß Susanne
AW: Archiv erstellen
07.08.2005 09:50:30
Matthias
Guten Morgen Susanne,
in welcher Zeile tritt denn der Fehler auf?
Gruß Matthias
AW: Archiv erstellen
07.08.2005 09:57:09
SusanneNr.1000
ups, das war mein Fehler, denn ich hatte vergessen die Namen anzupassen ...
AW: Archiv erstellen
07.08.2005 10:55:12
SusanneNr.1000
Ich habe das Problem gelöst !!! Das Problem war das mir wohl irgendwie in Zeile 6000undirgendwas Daten gerutscht sind, die ich nicht bemerkt habe. Als ich diese herausgelöscht habe ging es plötzlich ... Ich verstehe zwar nicht warum, aber Hauptsache es geht! War vielleicht außerhalb des Gültigkeitsbereichs ? Also noch einmal vielen Dank für eure Hilfe, vor allem natürlich an Matthias !
Liebe Grüße Susanne
Anzeige
AW: Archiv erstellen
07.08.2005 10:57:11
Matthias
Hallo Susanne,
Freut mich!
Na dann, schönen Sonntag noch.
Gruß Matthias

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige