[VBA] Objekte einer Klasse mit Inhalt aus verschiedenen Excel Tabellen füllen?

...komplette Frage anzeigen

2 Antworten

Weiss zwar net wieso du ne neue Frage aufmachst, aber egal :D

Hier der gesamte Code um auch die Adressen von einem anderen Dokument mitzunehmen.

In diesem Code gehe ich davon aus, dass folgende Vorkehrungen getroffen sind:

  • Excel1 -> Spalte1: Name, Spalte 7: Stundenzahl
  • Excel2 -> Spalte1: Name, Spalte 7: Adresse

Ein automatisches schließen der Excel2 nach dem auslesen habe ich jetzt nicht eingebaut, da das ja nicht in deiner Frage stand :)

Zu beachten ist bei dem Code so wie er jetzt ist, dassdu das Makro immer aus der Excel1 heraus starten musst.

Public Sub Run()
Dim members As Collection
Set members = New Collection

Dim memberAddrs As Object
Set memberAddrs = CreateObject("Scripting.Dictionary")

Dim row, row2 As Long
Dim maxRow, maxRow2 As Long
Dim workbooks2 As Object
Dim sheet, sheet2 As Worksheet

Set sheet = ActiveWorkbook.Worksheets(1)
maxRow = sheet.Cells(sheet.Rows.Count, "A").End(xlUp).row

Set workbooks2 = Workbooks.Open("PFAD ZU DEINER EXCEL")

Set sheet2 = workbooks2.Worksheets(1)

maxRow2 = sheet2.Cells(sheet2.Rows.Count, "A").End(xlUp).row

Dim curName As String
Dim curHour As Integer
Dim curAddr As String
Dim curName2 As String
Dim curAddr2 As String

For row2 = 1 To maxRow2
curName2 = sheet2.Cells(row2, 1)
curAddr2 = sheet2.Cells(row2, 7)
If Not memberAddrs.Exists(curName2) Then
Call memberAddrs.Add(curName2, curAddr2)
End If
Next row2

For row = 1 To maxRow
curName = sheet.Cells(row, 1)
curAddr = memberAddrs(curName)
curHour = Val(sheet.Cells(row, 7))
If Not MemberExist(members, curName) Then
Set newMember = New Auftrag
Call newMember.Create(curName, curHour, curAddr)
Call members.Add(newMember)
Else
Set checkMember = GetMemberByName(members, curName)
checkMember.AddHours (Val(curHour))
End If
Next row


Dim member As Auftrag
For Each member In members
MsgBox ("Name: " & member.GetName & vbNewLine & "Stunden: " & member.GetHours & vbNewLine & "Adresse: " & member.GetAddr)
Next member
End Sub
Private Function GetMemberByName(list As Collection, name As String) As Auftrag
Dim member As Auftrag

For Each member In list
If member.GetName = name Then
Set GetMemberByName = member
Exit Function
End If
Next member
End Function
Private Function MemberExist(list As Collection, name As String) As Boolean
Dim member As Auftrag

For Each member In list
If member.GetName = name Then
MemberExist = True
Exit Function
End If
Next member

MemberExist = False
End Function

Klassenmodul "Auftrag":

Private M_name As String
Private M_hours As Integer
Private M_addr As String
Public Sub Create(ByVal name As String, ByVal hours As Integer, ByVal addr As String)
M_name = name
M_hours = hours
M_addr = addr
End Sub
Public Function GetName() As String
GetName = M_name
End Function
Public Function GetHours() As Integer
GetHours = M_hours
End Function
Public Function GetAddr() As String
GetAddr = M_addr
End Function
Public Sub AddHours(hours As Integer)
M_hours = M_hours + hours
End Sub



MFG xGlumi

ChrisFragtGern 07.07.2017, 14:04

Du bist einfach der beste :)), das probier ich nachher direkt aus.

Hab eine neue Frage gestartet, um das alles ein bisschen ausführlicher und genauer darzustellen.

0
ChrisFragtGern 07.07.2017, 14:21

Also Ich habe jetzt meinen Pfad eingebaut und geprüft obs klappt, das mit den Stunden + Namen funktioniert super.

Allerdings gibt der nie was im Adressenfeld aus, auch wenn die Namen in Exceldokument 1 und Exceldokument 2 übereinstimmen.

0
xGlumi 07.07.2017, 14:28
@ChrisFragtGern

Könntest du einmal Bilder von den beiden Dokumenten machen?

Denn bei mir (mit dummy Dokumenten) funktioniert es so.

MFG xGlumi

0
ChrisFragtGern 07.07.2017, 14:50
@xGlumi

Bekommst du :)

Hier ist Excel Dokument 1 von dem ich aus das Makro starte:

https://abload.de/img/excel11ku2u.png

Und hier ein Beispieleintrag fürs zweite, kann dir nicht das richtige dokument geben, da sind vertrauliche Daten drin:

https://abload.de/img/excel2vpuyr.png

Allerdings wär es am besten wenn man die zweite datei von unten nach oben durchgeht, da unten die aktuelleren Adressen drinstehen und es sein kann, dass ein Name mehrfach vorkommt, mit unterschiedlichen Adressen.

Außerdem habe ich vergessen zu erwähnen, dass Exceldokument 2 mehrere Arbeitsmappen hat und der Name theoretisch in Mappe 1 oder 2 stehen kann. Allerdings ist die Spalte immer "B"

(Hab das in deinem Code schon auf die richtigen Spalten geändert, also Dokument 1: Name Spalte A und Stunden Spalte G
Dokument 2: Name Spalte B und Adresse C)

Dazu kommt das die obersten beiden Zeilen der Dokumente mit Überschriften versehen sind und nicht beachtet werden sollen.

Ich hoffe das hilft dir

0
xGlumi 07.07.2017, 15:22
@ChrisFragtGern

Hmm, schade ich habe mir erhofft durch die Bilder ein Problem ausfindig machen zu können, aber leider sehe ich dort kein Problem.

Kannst du evt. die Dokumente Inhaltlich einwenig mit "Fake Daten" bearbeiten und die dann hier hochladen?

MFG xGlumi

1
ChrisFragtGern 13.07.2017, 15:26
@ChrisFragtGern

Also ich habe gerade rausgefunden, dass das Exceldokument 2 verschiedene Arbeitsmappen besitzt. Es kann sein, dass die Verbindung von Name und Adresse in Mappe 1 oder Mappe 2 steht.
Wie schaffe ich es denn, dass der Algorithmus beide Worksheets überprüft und nicht nur das erste?

0
xGlumi 13.07.2017, 15:31
@ChrisFragtGern
    Dim sheetNumber As Integer
For sheetNumber = 1 To ActiveWorkbook.Worksheets.Count
MsgBox (ActiveWorkbook.Worksheets(sheetNumber).Name)
Next sheetNumber

MFG xGlumi

0

Wenn das auch nur halbwegs funktioniert, hat Glumi eine Hilfreichste mehr als verdient!

Aus diesem Grund eine zweite AW!

Was möchtest Du wissen?