Anzeige
Archiv - Navigation
804to808
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
804to808
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Archivierung von Datensätzen mit VBA

Archivierung von Datensätzen mit VBA
23.09.2006 12:02:46
Matthias
Mahlzeit,
ich habe folgendes vor: Die Datensätze, die ich in einem Eingabeblatt eingebe, sollen mittels VBA auf einem anderen Blatt "Archiv" zeilenweise übernommen werden. Vor dem Übernehmen der Daten soll eine Bestätigungsrage a la "Wollen Sie die Daten archivieren?" kommen. So weit habe ich das mit einiger Hilfe auch schon hinbekommen, siehe: https://www.herber.de/bbs/user/36945.xls
Was mache ich nun aber, wenn die Daten im Blatt "Eingabe" nicht in der richtigen Reihenfolge untereinander stehen, sondern in verschiedenen Zellen durcheinander und verteilt, wie in diesem Beispiel:

Die Datei https://www.herber.de/bbs/user/36946.xls wurde aus Datenschutzgründen gelöscht

.
Vielen Dank schon mal für Lösungsvorschläge!!
Matthias

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Archivierung von Datensätzen mit VBA
23.09.2006 13:47:06
Reinhard
Hi Matthias,
den Code zwischen Dim und Set kannste ja löschen wenn das Blatt schon besteht.
Das "Transpose" von "EingabeFormatiert" nach "Archiv" musste noch einbauen.
Ggfs. nach dem Transpose das Blatt löschen, dann muss aber zwischen Dim und Set stehen:
Worksheets.Add
ActiveSheet.Name = "EingabeFormatiert"
Option Explicit
Sub tt()
Dim zei As Long, vorh As Boolean, ws As Worksheet, spa As Integer, wsEF As Worksheet, zeiEF
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "EingabeFormatiert" Then vorh = True
Next ws
If vorh = False Then
Worksheets.Add
ActiveSheet.Name = "EingabeFormatiert"
End If
Set wsEF = Worksheets("EingabeFormatiert")
wsEF.UsedRange.ClearContents
With Worksheets("Eingabe")
For zei = 1 To .UsedRange.Rows.Count
If Application.WorksheetFunction.CountA(Rows(zei)) <> 0 Then
spa = 1
While .Cells(zei, spa) = ""
spa = spa + 1
Wend
zeiEF = zeiEF + 1
.Range(.Cells(zei, spa), .Cells(zei, spa + 1)).Copy Destination:=wsEF.Range("A" & zeiEF)
End If
Next zei
.Activate
End With
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
AW: Archivierung von Datensätzen mit VBA
23.09.2006 14:53:19
Matthias
Hi,
ich habe versucht, Deine Antwort nachzuvollziehen, verstehe aber nicht ganz welchen Code ich jetzt wo austauschen muss. Meine VBA-Kenntnisse sind sehr dürftig, deshalb bin ich ein bisschen auf Eure Hilfe angewiesen...
Matthias
AW: Archivierung von Datensätzen mit VBA
23.09.2006 16:56:34
Matthias
Hi,
vielleicht habe ich das Problem auch nicht ganz klar formuliert: Ich möchte einen Datensatz, dessen (Einzel-)Daten in verschiedenen Zellen auf dem Blatt "Eingabe" verteilt sind, in einer bestimmten Reihenfolge auf das Blatt "Archiv" kopieren. In dieser Datei https://www.herber.de/bbs/user/36945.xls funktioniert dies schon, nur sind hier die (Einzel-)Daten schon in der richtigen Reihenfolge untereinander vorhanden. Wie muss ich in VBA vorgehen, wenn dies nicht der Fall ist, wie in dieser Datei:

Die Datei https://www.herber.de/bbs/user/36946.xls wurde aus Datenschutzgründen gelöscht

?
Es muss folglich nur ein Teil des Codes ausgetauscht werden, der für das Kopieren der Daten zuständig ist.
Danke schon mal,
Matthias
Anzeige
AW: Archivierung von Datensätzen mit VBA
23.09.2006 18:55:08
Josef Ehrensberger
Hallo Matthias!
Ich würde mit Namen arbeiten.
Vergib zuerst allen Eingabezellen einen Namen. Für meinen Code habe ich den Namen
"ip_X" verwendet, wobei das X für die Reihenfolge der Zellen steht.
Also "ip_1" für die erste, "ip_2" für die zweite, usw.
Dann kannst du diesen Code verwenden.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************


Option Explicit

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************


Option Explicit

' **********************************************************************
' Modul: Tabelle2 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************


Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim intIndex As Integer

If Target.Column = 1 Then
  Cancel = True
  For intIndex = 1 To 7
    Sheets("Eingabe").Range("ip_" & intIndex) = Cells(Target.Row, intIndex).Value
  Next
End If

End Sub


' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Ins_Archiv()
Dim lngNext As Long
Dim intIndex As Integer

With Sheets("Eingabe")
  If Application.CountA(.Range("ip_1"), .Range("ip_2"), .Range("ip_3"), .Range("ip_4"), _
    .Range("ip_5"), .Range("ip_6"), .Range("ip_7")) = 0 Then Exit Sub
End With

With Sheets("Archiv")
  lngNext = .Cells(Rows.Count, 1).End(xlUp).Row + 1
  For intIndex = 1 To 7
    .Cells(lngNext, intIndex) = Sheets("Eingabe").Range("ip_" & intIndex).Value
    Sheets("Eingabe").Range("ip_" & intIndex) = ""
  Next
End With

End Sub


Gruß Sepp
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige