Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1560to1564
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
Inhaltsverzeichnis

Mehrere Tabellen addieren

Mehrere Tabellen addieren
06.06.2017 15:17:24
sManthy
Hallo Zusammen!
folgendes Problem:
Ich habe eine beliebige Anzahl an Datein die jeweils eine Tabelle mit beliebiger Zeilen- und beliebiger Spaltenanzahl beinhaltet. in der Tabelle ist festgehalten, wie oft eine FehlerID (a,b,c,d,...) pro Gerät (A,B,C,D,...) vorgekommen ist.
ABER: Die Tabelle ist nicht in jeder Datei gleich (sprich immer A,B,C,D...) sondern in einer Datei kommen mal nur A,C,E vor und nur zB die Fehler a,b,f. In der nächsten Datei is vll nur C vorhanden und nur der Fehler A usw.
Was allerdings konstant ist: Maximale Geräteanzahl = 50 & maximale FehlerID Anzahl = 50.
Beispiele:
...A..B..C..D
a..2.....1..4
b........5
c..1..1..1
...B..G..H
b.....1
c..9..5..3
g.....2..3
...B
a..1
c..2
h 7
Mein Ziel ist es nun per VBA eine große Tabelle zu erstellen in der alle FehlerIDs und alle Geräte aufgeführt sind. Wenn in mehreren Tabellen eine FehlerID/Geräte-Kombination vorkommt (im Bsp. zB Gerät:B & FehlerID:c) dann sollen diese in der neuen Tabelle addiert werden. (Im Bsp. also: 9+2+1 = 12)
Zur Lösung:
Ich stehe momentan noch ohne eigenen brauchbaren Code da. Ich vermute mal es wird sich irgendwie per FOR-Schleife und/oder vlookup und/oder xlPasteSpecialOperationAdd lösen lassen, aber mich lassen meine fehlenden Programmierkenntnisse hier einfach im Stich.
Vielleicht noch zur Anmerkung: ich habe zur Anschaulichkeit als Gerätenamen und FehlerID fortlaufende Einzelbuchstaben genommen. In Wirklichkeit handelt es sich aber um zufällige Buchstaben und Zahlenkombinationen die zwischen 3 und 10 zeichen lang sind. Ideen die darauf abzielen, die unvollständigen Tabellen um Dummy-Zeilen zu erweitern werden also leider nicht fruchten.
Mega kompliziert, aber ich hoffe ich habe es halbwegs verständlich rüber gebracht.
Besten Dank schonmal vorab, an die tolle Community!
Grüße
sManthy

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Tabellen addieren
06.06.2017 15:54:32
Max2
Hallo,
wenn du eine Liste mit allen Fehler-IDs und Geräten hast, ist das gut und schnell zu lösen.
Eine Beispiel Datei wäre hier sehr hilfreich.
Wenn du keine List mit Fehler-IDs und Gerätekombis hast, die vorkommen können, dann muss eine Art Datenbank erstellt werden die sich selbst um Spalten ergänzt.
Da wird das ganze dann etwas größer und aufwendiger... mir persönlich zu aufwendig.
AW: Mehrere Tabellen addieren
06.06.2017 16:16:26
sManthy
Hallo Max2,
danke für die schnelle Antwort.
ich habe die "Beschriftungen" der Gesamttabelle bei meiner Fragestellung bereits gegeben. Sprich die Gesamttabelle hat bereits alle FehlerIDs und alle Geräte die in allen Datein vorkommen bereits einmal aufgeführt. Es fehlen nur noch die Summen der aufgetretenen Fehler-IDs.
Ich habe dazu nun auch eine Beispiel-Mappe angefertigt und angehängt.
https://www.herber.de/bbs/user/114061.xlsx
Kleine Anmerkung dazu: Ich habe hier anstatt mehrerer Workbooks einfach mehrere Worksheets erstellt. Die Transferleistung das dann abzuändern sollte ich noch hin bekommen ;-)
Ich hoffe das macht es klarer!
Grüße
sManthy
Anzeige
AW: Mehrere Tabellen addieren
06.06.2017 16:49:46
yummi
Hallo sManthy,
so in etwa (beim 2. Durchlauf musst du die Werte in der masterdatei vorher löschen)

Sub ErstelleMaster()
Dim wks As Worksheet
Dim wkb As Workbook
Dim lastZ As Long
Dim lastS As Integer
Dim s, z As Long
Dim rng As Range
Dim DestS As Integer
Dim DestZ As Long
Dim wksD As Worksheet
Dim lastD As Long
Set wkb = ThisWorkbook
Set wksD = wkb.Sheets("MasterMatrix-Datei")
lastD = BestimmeLetzteZeile(wksD, 2)
For Each wks In wkb.Worksheets
If wks.Name  "MasterMatrix-Datei" Then
lastZ = BestimmeLetzteZeile(wks, 2)
lastS = BestimmeLetzteSpalte(wks, 2)
For s = 3 To lastZ
Set rng = FindeWert(wksD, "C2:H2", wks.Cells(2, s).Value)
If Not rng Is Nothing Then
DestS = rng.Column
Set rng = Nothing
For z = 3 To lastS
Set rng = FindeWert(wksD, "B3:B" & lastD, wks.Cells(z, 2).Value)
If Not rng Is Nothing Then
wksD.Cells(rng.Row, DestS).Value = wksD.Cells(rng.Row, DestS).Value  _
+ wks.Cells(z, s).Value
End If
Next z
End If
Next s
End If
Next
End Sub
Function BestimmeLetzteZeile(ByVal wks As Worksheet, ByVal s As Integer) As Long
BestimmeLetzteZeile = wks.Cells(wks.Rows.Count, s).End(xlUp).Row
End Function
Function FindeWert(ByVal wks As Worksheet, ByVal strRange As String, ByVal strWert As String)  _
As Range
Set FindeWert = wks.Range(strRange).Find(strWert)
End Function
Function BestimmeLetzteSpalte(ByVal wks As Worksheet, ByVal z As Long) As Integer
BestimmeLetzteSpalte = wks.Cells(z, 256).End(xlToLeft).Column
End Function
Function Beschleunigen(ByVal BGesetzt As Boolean)
BGesetzt = Not BGesetzt
With Application
.ScreenUpdating = BGesetzt
.AskToUpdateLinks = BGesetzt
.EnableEvents = BGesetzt
.Calculation = BGesetzt
.DisplayAlerts = BGesetzt
End With
End Function
Gruß
yummi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige