Live-Forum - Die aktuellen Beiträge
Datum
Titel
15.07.2024 16:00:57
15.07.2024 15:41:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Register durchsuchen und berechnen

VBA Register durchsuchen und berechnen
26.08.2014 17:41:37
Uwe

Hallo,
habe folgendes Problem:
meine ExcelDatei hat folgende Register
Inhalt
1.1
1.2
1.3
2.1
usw.
Gesamt
Formular100061
Im Formular100061 stehen in Spalte A Positonsmummern in verschiedenen Formaten
in den darauffolgenden Spalten stehen Informationen zu der entsprechenden Pos.Nr aus Spalte A
Die Register 1.1, 1.2, 1.3 usw. sind immer gleich aufgebaut, können aber auch 2.1 2.2 usw. heißen.
in diesen Registern werden über SVERWEIS einzelne Positionen mit den dazugehörigen Informationen aus Formular100061 abgefufen und zur weiteren Berechnung in Spalte E mit Mengen zur versehen.
Jetzt zum Problem.
Mein Makro muss diese Register nach benutzten Positionen einschl. der aufgeführten Mengen durchsuchen, und im Register Gesamt die gefundenen Positionen einschl. der zugehörigen Informationen und Mengen auflisten.
Weiterhin ist dann die Gesamtmenge zu berechnen.
Es kommt hinzu, dass in den einzelnen Registern Positionen doppelt vorkommen können. zB. im Register 1.2 die Position 16.30.01.10.
Wird die Tabelle mit Registern vom Typ 1.1 erweitert (2.1, 2,2, 3.1, 3.2, 3,3 usw.)
muss das Makro das Register Gesamt aktualisieren bzw. neu berechnen. Falls neue Positionen aus Register Formular100061 gefunden wurden sind die entsprechenden Zeilen einzufügen.
Ich kann einfache Makros lesen und ggf. verändern, aber diese Aufgabe überschreitet meine Kenntnisse.
Vielleicht kann mir jemand auf die Sprünge helfen.
Die Excel-Datei füge ich bei.
https://www.herber.de/bbs/user/92307.xlsx
Vielen Dank
Uwe

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Register durchsuchen und berechnen
26.08.2014 21:25:38
Christian
hallo Uwe,
Deine Tabellenblätter - du nennst es "Register" - sind ja immer gleich aufgebaut.
Daher mein Vorschlag:
schreibe Daten mit gleicher Struktur in eine Tabelle.
In dieser Tabelle könntest du in einer weiteren Spalte zu jedem Eintrag die "Kategorie" (1.1, 1.2, ... 3.1, 3.2, 3.3, ... usw.) eintragen und dann zB. "Summe je Kategorie", "Gesamtsumme", oder was auch immer mit einfachen Excelformeln abfragen.
Bei Verteilung der Datensätzen auf verschiedene Tabellenblätter wird die Auswertung schwieriger.
Gruß
Christian

AW: VBA Register durchsuchen und berechnen
26.08.2014 23:11:04
Uwe
Hallo Christian,
Die Tabellenblätter sind Kundenformulare, die ausgefüllt in gleicher Form wieder zurück geschickt werden müssen.
Die Tabelle Gesamt soll einen Überblick verschaffen, welche Blätter mit welchen Positionen bereits zurückgegeben wurden.
Gruß
Uwe

Anzeige
AW: VBA Register durchsuchen und berechnen
27.08.2014 21:44:30
Christian
Hallo Uwe,
im Prinzip dann wie folgt:
- lösche alle Einträge in "Gesamt" ab Zeile-16
- schreibe die ID's aus "Formular100061", Spalte-B in ein Array (nennen wir es mal "vntListe")
- durchlaufe alle Tabellenblätter, deren Name dem Muster "Ziffer-Punkt-Ziffer" entspricht
- die ID steht hier jeweils in Spalte-A.
- wenn es die ID in "vntListe" gibt, dann:
- wenn diese ID in Tabelle "Gesamt" noch nicht eingetragen ist, dann schreibe die Einträge aus "vntListe" in die Tabelle "Gesamt" und die Mengen aus dem Tabellenblatt "Ziffer-Punkt-Ziffer" in der entsprechenden Spalte (G, H, I, ...)
- wenn es diese ID in Tabelle "Gesamt" schon gibt, dann summiere die Mengen in der entsprechenden Zeile und Spalte (G, H, I, ...)
Zuletzt noch die Summen in Spalte-F berechnen.
Ich könnte dir auch ein fertiges Makro schreiben (ca. 50 bis 100 Zeilen Code), aber zum einen sind deine Tabellen für mich nicht ganz verständlich, da zB. mehrere Spalten und Zeilen ausgeblendet sind und zum anderen lernst du nichts dabei.
Grüße
Christian

Anzeige
AW: VBA Register durchsuchen und berechnen
29.08.2014 21:14:16
Uwe
Hallo Christian,
danke für deinen Leitfaden.
bin schon dabei das Makro zu schreiben.
mal sehen wie weit ich komme.
Gruß
Uwe

AW: VBA Register durchsuchen und berechnen
30.08.2014 11:20:45
Christian
Hallo Uwe,
schön, dass du mit meinem Leitfaden etwas anfangen kannst.
Falls du wider Erwarten nicht weiter kommen solltest, dann schau dir mal den folgenden Ansatz an:
Option Explicit
Sub TestIt()
Dim wks As Worksheet, wksList As Worksheet, wksDest As Worksheet
Dim objRgxp As Object, objList As Object, objDest As Object
Dim lngWks As Long, lngSum As Long, i As Long, k As Long
Dim strID As String
Set wksList = ThisWorkbook.Sheets("Formular100061")
Set wksDest = ThisWorkbook.Sheets("Gesamt")
Set objDest = CreateObject("SCripting.Dictionary")
Set objList = CreateObject("SCripting.Dictionary")
Set objRgxp = CreateObject("VbScript.Regexp")
With objRgxp
.Pattern = "^\d\.\d$"
.Global = False
.MultiLine = False
End With
With wksList
For i = 6 To .Cells(Rows.Count, 2).End(xlUp).Row
objList(.Cells(i, 2).Text) = i
Next
End With
wksDest.Rows(10).ClearContents
wksDest.Rows(10).NumberFormat = "@"
k = 16
wksDest.Rows(k).Resize(wksDest.Rows.Count - k + 1).ClearContents
For Each wks In ThisWorkbook.Worksheets
If objRgxp.Test(wks.Name) Then
With wks.UsedRange
For i = 1 To .Rows.Count
strID = .Cells(i, 1)
If objList.Exists(strID) Then
If Not objDest.Exists(strID) Then
wksDest.Cells(k, 1) = strID
wksDest.Cells(k, 3) = wksList.Cells(objList(strID), 8)
wksDest.Cells(k, 4) = wksList.Cells(objList(strID), 15)
wksDest.Cells(k, 5) = wksList.Cells(objList(strID), 19)
wksDest.Cells(k, lngWks + 7) = .Cells(i, 5)
objDest(strID) = k
k = k + 1
Else
wksDest.Cells(objDest(strID), lngWks + 7) = _
wksDest.Cells(objDest(strID), lngWks + 7) + .Cells(i, 5)
End If
End If
Next
End With
wksDest.Cells(10, lngWks + 7) = wks.Name
wksDest.Cells(11, lngWks + 7) = "Menge"
lngWks = lngWks + 1
End If
Next
With wksDest
For i = 16 To .Cells(Rows.Count, 1).End(xlUp).Row
lngSum = 0
For k = 1 To lngWks
lngSum = lngSum + .Cells(i, k + 6)
Next
.Cells(i, 6) = (.Cells(i, 4) + .Cells(i, 5)) * lngSum
Next
End With
Set wksList = Nothing
Set wksDest = Nothing
Set objDest = Nothing
Set objList = Nothing
Set objRgxp = Nothing
End Sub
Gruß
Christian

Anzeige

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige