Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

VBA Register durchsuchen und berechnen

Betrifft: VBA Register durchsuchen und berechnen von: Uwe
Geschrieben am: 26.08.2014 17:41:37

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







  

Betrifft: AW: VBA Register durchsuchen und berechnen von: Christian
Geschrieben am: 26.08.2014 21:25:38

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


  

Betrifft: AW: VBA Register durchsuchen und berechnen von: Uwe
Geschrieben am: 26.08.2014 23:11:04

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


  

Betrifft: AW: VBA Register durchsuchen und berechnen von: Christian
Geschrieben am: 27.08.2014 21:44:30

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


  

Betrifft: AW: VBA Register durchsuchen und berechnen von: Uwe
Geschrieben am: 29.08.2014 21:14:16

Hallo Christian,
danke für deinen Leitfaden.
bin schon dabei das Makro zu schreiben.
mal sehen wie weit ich komme.

Gruß
Uwe


  

Betrifft: AW: VBA Register durchsuchen und berechnen von: Christian
Geschrieben am: 30.08.2014 11:20:45

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


 

Beiträge aus den Excel-Beispielen zum Thema "VBA Register durchsuchen und berechnen"