AW: Tabellenautomatisierung - Tabellen kopieren
22.05.2018 13:44:20
Peter(silie)
Hallo,
dein Code erreicht doch nichts von dem was du eigentlich wolltest?
Hier deine Mappe mit IDs: https://www.herber.de/bbs/user/121745.xlsm
Schau dir den Code an im Modul: WasAuchImmer
Und durchlaufen ihn mit dem debugger schritt für schritt.
Der Code ist kommentiert.
Wenn du fragen hast, kannst du die gerne stellen.
Den Code musst du auf dich anpassen.
Ich tue das nicht für dich.
Ich zeige dir nur, wie man bestimmte Sachen in VBA erreichen kann,
alles weitere musst du selber rausfinden.
Hier nur Code:
Option Private Module
Option Explicit
'// Mit einem Type kann man selbst ein
'// ein Datenmodell darstellen.
'// Den Type DATASET kannst du auf dich anpassen
'// Du könntest auch für jedes Blatt einen eigenen Typen erstellen
'// Also: Private Type AKTUELLES, Private Type LESEN usw.
'// Dadurch kannst du ganz genau festlegen welche daten da rein kommen sollen!
Private Type DATASET
ID As String 'Datensatz ID
TimeStamp As String 'Zeitstempel der letzten Bearbeitung
Category As String 'Unterkategorie
Reviser As String 'Bearbeiter
DateOfBegin As Date 'Datum (Anfang)
DateOfEnd As Date 'Datum (Ende)
Title As String 'Titel
Link As String 'Link
Others As String 'Sonstiges
End Type
'// Diesen Sub kannst du aufrufen da er nicht Private ist
'// Durch "Option Private Module" kannst du diesen Sub allerdings
'// nicht durch ALT+F8 aus Excel heraus starten, du musst ihn aus
'// einem anderen Modul oder Userform heraus aufrufen.
'// Entferne Option Private Module, wenn du die Sachen auch aus
'// Excel heraus aufrufen willst.
Public Sub ValidateData()
Dim d As Object 'Dictionary Object
Dim v As Variant 'Für Schleife
Dim ab As DATASET 'Datensatz Variable (Unser eigener Datentyp)
'// Rufe Funktion auf zum holen der IDs im Tabellenblatt "Aktuelles"
Set d = GetIDs(ThisWorkbook.Sheets("Aktuelles"))
On Error Resume Next
'Für jeden Key im Dictionary
For Each v In d.Keys
'// Hole die Daten aus "Gesamte Tabelle"
'// Hole die Daten wo die ID gleich die gesuchte ID
'// Zeige die Ergebnisse im Direktbereich an
ab = GetDataset(ThisWorkbook.Sheets("Gesamte Tabelle"), v, d(v))
Debug.Print "==================================="
Debug.Print "Datensatz: " & ab.ID
Debug.Print "==================================="
Debug.Print "Timestamp: " & ab.TimeStamp
Debug.Print "Category: " & ab.Category
Debug.Print "Reviser: " & ab.Reviser
Debug.Print "Date Of Begin: " & ab.DateOfBegin
Debug.Print "Date Of End: " & ab.DateOfEnd
Debug.Print "Title: " & ab.Title
Debug.Print "Link: " & ab.Link
Debug.Print "Others: " & ab.Others
Debug.Print "==================================="
Debug.Print
'// Setze den Datensatz zurück
ResetDataset ab
Next v
End Sub
'// Speichert alle IDs und Ihre Zeitstempel in einem
'// Dictionary Objekt ab
'// Ein Dictionary hat nur eindeutige Werte.
'// Diese werden Key genannt.
'// Ein Dictionary Key hat ein Value also einen Wert
'// Dieser ist nicht eindeutig
Private Function GetIDs(ByRef shTable As Worksheet) As Object
Dim rowData As Variant 'Array mit IDs + Zeitstempel
Dim dict As Object 'Dictionary Object
Dim lRow As Long 'Letzte Zeile
Dim i As Long 'iterator
'// wenn die übergebene Tabelle nichts ist dann verlasse die Funktion
If shTable Is Nothing Then Exit Function
'// erstelle ein Dictionary Object durch Latebinding
Set dict = CreateObject("Scripting.Dictionary")
With shTable
'// finde Letzte Zeile in Spalte A
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lRow = 1 Then Exit Function
'// erstelle Array mit Werten (Arrays sind schneller als Ranges)
rowData = .Range(.Cells(2, 1), .Cells(lRow, 2)).Value
'// Gehe durch alle Werte des Arrays
For i = LBound(rowData, 1) To UBound(rowData, 1)
'// Füge die IDs + Zeitstempel hinzu
'// Dictionary(key) = Value
'// key = ID Value = Timestamp
dict(rowData(i, 1)) = rowData(i, 2)
Next i
End With
'// Übergebe das Dictionary Object an die Funktion
Set GetIDs = dict
End Function
'// Holt sich die Datensatz Daten per ID aus einer Vorgegeben Tabelle (LookUpTable)
'// Gibt unseren Benutzerdefinierten Typen DATASET zurück
Private Function GetDataset(ByRef LookUpTable, _
ByVal ID As String, _
ByVal TimeStamp As Variant) As DATASET
Dim vData As Variant 'Speichtert alle Daten einer Zeile
Dim IdTable As Variant 'Speichert alle Daten der Spalte A
Dim lRow As Long 'Letzte Zeile
Dim i As Long 'iterator
'// Falls die Tabelle nichts ist dann verlasse die Funktion
If LookUpTable Is Nothing Then Exit Function
With LookUpTable
'// Letzte Zeile
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'// Array mit allen Daten
vData = .Range(.Cells(1, 1), .Cells(lRow, 10)).Value
'// Array mit IDs
IdTable = .Range(.Cells(1, 1), .Cells(lRow, 1)).Value2
'// Finde die gesuchte ID
lRow = FindID(IdTable, ID)
If lRow > 1 Then
'// Falls die ID gefunden wurde dann
'// Füge alle Werte in unseren eigenen Daten Typen ein
GetDataset.ID = ID
GetDataset.TimeStamp = vData(lRow, 2)
GetDataset.Category = vData(lRow, 3)
GetDataset.Reviser = vData(lRow, 5)
GetDataset.DateOfBegin = vData(lRow, 6)
GetDataset.DateOfEnd = vData(lRow, 7)
GetDataset.Title = vData(lRow, 8)
GetDataset.Link = vData(lRow, 9)
GetDataset.Others = vData(lRow, 10)
End If
End With
End Function
'// Sucht nach einer ID innerhalb eines Arrays oder einer Range (NUR IN EINER SPALTE)
Private Function FindID(ByRef Source As Variant, ByVal Find As Variant) As Long
If Not VBA.IsError(Application.Match(Find, Source, 0)) Then
FindID = Application.Match(Find, Source, 0)
End If
End Function
'// Setzt eine Variable unseres Benutzerdefinierten Typen zurück
Private Sub ResetDataset(ByRef ds As DATASET)
Dim tmp As DATASET
ds = tmp
End Sub