Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1544to1548
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

Ich brauch nochmal die Experten

Ich brauch nochmal die Experten
27.02.2017 15:21:07
walter
Hallo zusammen,
ich werde diese Anfrage NUR einmal senden also Vorschau und dann raus,
mal sehen ob wieder 2x erscheint.
Nun zur Frage:
Ich habe in meiner Master Datei unterschiedliche Anzahl von Sheets.
Jetzt möchte ich aus den Sheets die Zahlen aus den Zellen
K57, K58, K68, K82, K88 in der Sheet "Übersicht" addieren.
Ferner darf die Sheet "Master" ebenfalls nicht berücksichtigt werden,
wichtig bei der Teilung also die "Master" und die "Übersicht" sind außen vor
Das 1. Problem, es kann sein das in einer Sheet kein Wert in einer der Zellen steht,
es sollen aber von den Sheets wo Werte/Zahlen drin stehen durch diese
Anzahl teilen.
Geht sowas per Makro, dann würde ich dies per CommandButton auslösen.
Hoffentlich war dies verständlich, ansonsten Fragen.
mfg
walter mb

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Blätter konsolidieren
27.02.2017 15:51:21
Michael
Hi,
das geht z.B. so:
Option Explicit
Sub WerteErzeugen()
Dim z&, r&, a
Dim sh As Worksheet
a = Range("xx50:xx90")
Randomize
For Each sh In ThisWorkbook.Worksheets
If sh.Name  "Master" And sh.Name  "Übersicht" Then
For z = 1 To UBound(a)
r = WorksheetFunction.RandBetween(0, 100)
If r >= 20 Then a(z, 1) = r Else a(z, 1) = Empty
Next
sh.Range("K50").Resize(UBound(a)) = a
End If
Next
End Sub
Sub WerteKonsoli()
Dim z&, zMax&, a, asumW, Zelle
Dim sh As Worksheet
Const sumW = "K57,K58,K68,K82,K88"
a = Split(sumW, ",")
zMax = UBound(a)
ReDim asumW(0 To zMax, 1 To 2)
For Each sh In ThisWorkbook.Worksheets
If sh.Name  "Master" And sh.Name  "Übersicht" Then
For z = 0 To zMax
Zelle = sh.Range(a(z))
If Zelle  "" Then _
asumW(z, 1) = asumW(z, 1) + Zelle: asumW(z, 2) = asumW(z, 2) + 1
Next
End If
Next
For z = 0 To zMax
Sheets("Übersicht").Range(a(z)) = asumW(z, 1)
Sheets("Übersicht").Range(a(z)).Offset(, 1) = asumW(z, 2)
Next
End Sub

wobei in Spalte L die Anzahl der Werte steht - das kannst Du in der Tabelle verrechnen oder direkt in VBA, je nach Gusto.
Datei zum Testen: https://www.herber.de/bbs/user/111804.xlsm
Schöne Grüße,
Michael
Anzeige
Danke muss ...
27.02.2017 16:10:41
walter
Hallo Michael,
das ist für mich böhmische Dörfer,
werde gleich testen.
mfg
walter mb
Hallo Michael und Chris Super aber
27.02.2017 16:43:56
walter
Hallo Michael und Chris,
anbei die Musterdatei.
Was in der Übersicht in Spalte I steht sollte das Ergebnis für Spalte K sein.
Bei Christ habe ich nur ein Ergebnis als MSGBOX.
Ihr seid Beide Künstler.
https://www.herber.de/bbs/user/111807.xlsm
mfg
walter mb
Hallo Michael wie ...?
27.02.2017 18:12:43
walter
Hallo Michael,
ich kann auch damit leben das die Daten nicht in Spalte K + L sondern
L + M eingetragen werden, was muss ich da ändern ?
mfg
walter mb
Anzeige
AW: Hallo Michael wie ...?
28.02.2017 08:39:00
ChrisL
Hi Walter
Ich hoffe ich habe die richtigen Spalten erwischt:
Sub WerteKonsoli()
Dim z&, zMax&, a, asumW, Zelle
Dim sh As Worksheet
Const sumW = "K57,K58,K68,K82,K88"
a = Split(sumW, ",")
zMax = UBound(a)
ReDim asumW(0 To zMax, 1 To 2)
For Each sh In ThisWorkbook.Worksheets
If sh.Name  "Master" And sh.Name  "Übersicht" Then
For z = 0 To zMax
Zelle = sh.Range(a(z))
If Zelle  "" Then _
asumW(z, 1) = asumW(z, 1) + Zelle: asumW(z, 2) = asumW(z, 2) + 1
Next
End If
Next
For z = 0 To zMax
Sheets("Übersicht").Range(a(z)).Offset(, 1) = asumW(z, 1)
Sheets("Übersicht").Range(a(z)).Offset(, 2) = asumW(z, 2)
Sheets("Übersicht").Range(a(z)) = asumW(z, 1) / asumW(z, 2)
Next
End Sub

Offset(Zeile, Spalte)
Offset(, 1) = eine Spalte weiter wie Spalte K d.h. Spalte L.
cu
Chris
Anzeige
Perfekt -)
28.02.2017 09:34:13
walter
Guten Morgen Chris,
perfekt DANKE nochmals !
mfg
walter mb
Hallo Chris, kleiner Fehler
28.02.2017 14:04:41
walter
Hallo Chris,
habe festgestellt, in meiner Datei werden die Tabellen (haben alle Namen)
Master (2), Master (3), Master (4) !,
alle in der Zelle K57 berücksichtigt also geteilt durch 3.
In deinem Muster aber nicht !
Du hast 5 Tabellen habe 2 gefüllt und diese werden auch nur berücksichtigt.
Woran kann es liegen ?
mfg
walter mb
AW: Hallo Michael wie ...?
28.02.2017 13:02:01
Michael
Hi,
im Prinzip ist nur eine Zeile zu ändern:
Sub WerteKonsoli()
Dim z&, zMax&, a, asumW, Zelle
Dim sh As Worksheet
Const sumW = "K57,K58,K68,K82,K88"
a = Split(sumW, ",")
zMax = UBound(a)
ReDim asumW(0 To zMax, 1 To 2)
For Each sh In ThisWorkbook.Worksheets
If sh.Name  "Master" And sh.Name  "Übersicht" Then
For z = 0 To zMax
Zelle = sh.Range(a(z))
If Zelle  "" Then _
asumW(z, 1) = asumW(z, 1) + Zelle: asumW(z, 2) = asumW(z, 2) + 1
Next
End If
Next
For z = 0 To zMax
If asumW(z, 2) > 0 Then
Sheets("Übersicht").Range(a(z)) = asumW(z, 1) / asumW(z, 2) ' die hier ***
Else
Sheets("Übersicht").Range(a(z)) = "#n.v."
End If
' Die beiden Zeilen nach Gusto auskommentieren:
Sheets("Übersicht").Range(a(z)).Offset(, 1) = asumW(z, 1)
Sheets("Übersicht").Range(a(z)).Offset(, 2) = asumW(z, 2)
Next
End Sub

Um eine Divsion /0 zu vermeiden mit einer If-Konstruktion. Könnte ja sein, daß mal gar kein Wert vorhanden ist.
Schöne Grüße,
Michael
Anzeige
Herzlichen Dank Michael
28.02.2017 14:51:08
walter
Michael auch bei Dir... kommisch
28.02.2017 15:00:17
walter
Hallo Michael,
das ist komisch,
auch bei deinem Makro in meiner Datei teilt er durch die 3 Tabellen, nur wenn ich die Leere
lösche durch 2.
mfg
walter mb
Mißverständnis?
28.02.2017 15:56:27
Michael
Hi,
ich dachte, die Anzahl der jeweiligen Zellen MIT Wert soll geteilt werden - deshalb die ganze Rumrechnerei.
Wenn IMMER nach der Anzahl der Tabellenblätter teilen willst, sieht es so aus:
Sub WerteKonsoli()
Dim z&, zMax&, a, asumW, Zelle
Dim sh As Worksheet, shNr&
Const sumW = "K57,K58,K68,K82,K88"
a = Split(sumW, ",")
zMax = UBound(a)
ReDim asumW(0 To zMax, 1 To 2)
shNr = 0 ' ***
For Each sh In ThisWorkbook.Worksheets
If sh.Name  "Master" And sh.Name  "Übersicht" Then
shNr = shNr + 1 ' ***
For z = 0 To zMax
Zelle = sh.Range(a(z))
If Zelle  "" Then _
asumW(z, 1) = asumW(z, 1) + Zelle: asumW(z, 2) = asumW(z, 2) + 1
Next
End If
Next
For z = 0 To zMax
' nach Gusto auskommentieren:
If asumW(z, 2) > 0 Then
Sheets("Übersicht").Range(a(z)) = asumW(z, 1) / asumW(z, 2)
Else
Sheets("Übersicht").Range(a(z)) = "#n.v."
End If
Sheets("Übersicht").Range(a(z)).Offset(, 1) = asumW(z, 1) / shNr
Sheets("Übersicht").Range(a(z)).Offset(, 2) = asumW(z, 1)
Sheets("Übersicht").Range(a(z)).Offset(, 3) = asumW(z, 2)
Sheets("Übersicht").Range(a(z)).Offset(, 4) = shNr
Next
End Sub

In Offset(,1), also K+1=L hast Du jetzt die Teilung durch die Anzahl der Blätter.
Schöne Grüße,
Michael
Anzeige
Michael auch bei Dir... kommisch
28.02.2017 15:50:56
walter
Hallo Michael,
das ist komisch,
auch bei deinem Makro in meiner Datei teilt er durch die 3 Tabellen, nur wenn ich die Leere
lösche durch 2.
mfg
walter mb
Hallo Chris und Michael hab den Fehler gefunden
28.02.2017 15:54:24
walter
Hallo Chris und Michael,
ich habe den Fehler gefunden, da in den Zellen:
"K57,K58,K68,K82,K88" Formel drin stehen wird halt diese
Tabelle ebenfalls berechnet bzw. bei der Teilung berücksichtigt.
Also nur Zellen die größer als >= SIND SOLLTEN BERÜCKSICHTIGT WERDEN:
Geht das ?
mfg
walter mb
AW: Hallo Chris und Michael hab den Fehler gefunden
28.02.2017 16:23:18
ChrisL
Hi Walter
Wenn ich das Makro von Michael richtig lese und dich richtig verstehe (langsam verliere ich den Überblick), dann so...
If Zelle  "" And Zelle.Value > 0 Then _
asumW(z, 1) = asumW(z, 1) + Zelle: asumW(z, 2) = asumW(z, 2) + 1
cu
Chris
Anzeige
Das ist mir schon peinlich... leider
28.02.2017 17:50:52
walter
Hallo Chris,
leider rechnet weiterhin FALSCH, wenn ich die leere Tabelle lösche,
ist ok.
mfg
walter mb
Bahnhof
28.02.2017 18:16:37
ChrisL
Hi Walter
Es muss dir nicht peinlich sein, aber ich verstehe gar nichts mehr. Vielleicht solltest du einfach nochmal eine neue Beispieldatei mit dem konkret erwarteten Ergebnis posten (Soll-Zustand).
cu
Chris
Gelöst !!!!!!!!!!!!!!!!! --))
28.02.2017 19:35:34
walter
Hallo Chris und Michael,
erst nochmal Danke für EURE Geduld !
Ich habe auf Grund der Musterdatei immer getest und habe mit diesem Makro
es geschafffffft !
Dim z&, zMax&, a, asumW, Zelle
Dim sh As Worksheet, shNr&
Const sumW = "K57,K58,K68,K82,K88"
a = Split(sumW, ",")
zMax = UBound(a)
ReDim asumW(0 To zMax, 1 To 2)
shNr = 0 ' ***
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Master" And sh.Name <> "Übersicht" Then
shNr = shNr + 1 ' ***
For z = 0 To zMax
Zelle = sh.Range(a(z))
' If Zelle <> "" Then _
asumW(z, 1) = asumW(z, 1) + Zelle: asumW(z, 2) = asumW(z, 2) + 1
If Zelle > 0 Then _
asumW(z, 1) = asumW(z, 1) + Zelle: asumW(z, 2) = asumW(z, 2) + 1
Next
End If
Next
For z = 0 To zMax
' nach Gusto auskommentieren:
If asumW(z, 2) > 0 Then
Sheets("Übersicht").Range(a(z)) = asumW(z, 1) / asumW(z, 2)
Else
' Sheets("Übersicht").Range(a(z)) = "#n.v."
Sheets("Übersicht").Range(a(z)) = 0
End If
Sheets("Übersicht").Range(a(z)).Offset(, 1) = asumW(z, 1) / shNr
Sheets("Übersicht").Range(a(z)).Offset(, 2) = asumW(z, 1)
Sheets("Übersicht").Range(a(z)).Offset(, 3) = asumW(z, 2)
Sheets("Übersicht").Range(a(z)).Offset(, 4) = shNr
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic ' MsgBox ActiveSheet.Name
ActiveWindow.ScrollRow = 55 '1 Zeile
ActiveWindow.ScrollColumn = 1 '1 Spalte
ActiveSheet.Range("D10").Select
Schönen Abend noch
mfg
walter mb
Anzeige
AW: Ich brauch nochmal die Experten
27.02.2017 16:00:39
ChrisL
Hi Walter
Oder so...
Sub t()
Dim WS As Worksheet, strBereich As String, rng As Range
Dim curSumme As Currency, iCounter As Integer
strBereich = "K57,K58,K68,K82,K88"
For Each WS In ThisWorkbook.Worksheets
If WS.Name  "Übersicht" And WS.Name  "Master" Then
For Each rng In WS.Range(strBereich)
If rng  "" And IsNumeric(rng) Then
iCounter = iCounter + 1
curSumme = curSumme + rng
End If
Next rng
End If
Next WS
MsgBox curSumme & " / " & iCounter & " = " & curSumme / iCounter
End Sub

cu
Chris
Hallo Chris werde...
27.02.2017 16:12:33
walter
Hallo Chris,
werde auch gleich mal testen,
melde mich.
mfg
walter mb
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige