Ja in allen Tabellenblättern stehen Daten von Zeile A6 bis A21
drin. Jedes Blatt ist exakt gleich.
Brauchst du noch mehr Infos oder reicht das?
hallo Ice,
wenn das so wäre hätte ich nich nachgefragt.
Bei dir geht es bei den zweiten Tabellen pro Blatt runter bis Zeile 39 o.ä.
Das ist der derzeitige Knackpunkt.
Gruß
Reinhard
Guten Tag,
Die unteren Tabellen kannst du komplett außer Acht lassen. Ich will nur die oberen sachen auswerten!!!
Icetea
Hi!!!
Na, schon getüftelt? Kanns kaum erwarten :o)
Liebe Grüße
ice
Na, schon getüftelt? Kanns kaum erwarten :o)
Hallo Ice,
Alt+F11, Doppelklick auf „Diese Arbeitsmappe“, Code reinkopieren, Editor schließen.
Option Explicit
'
Private Sub Workbook\_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wks As Worksheet, ZeiSD As Long, Zei As Long
If Sh.Name = "Statistik Doppelte" Then Exit Sub
If Intersect(Target, Range("A6:H21")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Statistik Doppelte")
ZeiSD = .Cells(.Rows.Count, 2).End(xlUp).Row
If ZeiSD \>= 4 Then .Range("A4:F" & ZeiSD).ClearContents
ZeiSD = 4
For Each wks In Worksheets
If wks.Name "Statistik Doppelte" Then
For Zei = 6 To 21
If wks.Cells(Zei, 8) \>= 1 Then
.Cells(ZeiSD, 1) = wks.Cells(1, 1)
.Cells(ZeiSD, 2) = wks.Cells(1, 2)
.Cells(ZeiSD, 3) = wks.Cells(Zei, 1)
.Cells(ZeiSD, 4) = wks.Cells(Zei, 8)
.Cells(ZeiSD, 5) = wks.Cells(Zei, 4)
.Cells(ZeiSD, 6) = .Cells(ZeiSD, 4) \* .Cells(ZeiSD, 5)
ZeiSD = ZeiSD + 1
End If
Next Zei
End If
Next wks
End With
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
Guten Tag,
Super!!! Vielen, vielen Dank! Klappt ausgezeichnet!!!
Danke für die Hilfe!
ice
Guten Tag,
Hi!
Wenn es dir nicht allzu viel Mühe macht, wollte ich fragen ob du die Zeilen erklären kannst, also was welche Zeile macht. Dann kann ich vielleicht selbst ein neues Makro schreiben, dass mir auswertet welche Figuren mir nich fehlen.
Danke
ice
Wenn es dir nicht allzu viel Mühe macht, wollte ich fragen ob
du die Zeilen erklären kannst, also was welche Zeile macht.
Dann kann ich vielleicht selbst ein neues Makro schreiben,
dass mir auswertet welche Figuren mir nich fehlen.
Hallo Ice,
okay, habe ich nachstehend versucht. Wird dir aber nicht viel helfen. Um herauszufinden welche ÜEier dir noch fehlen brauchst du ja eine Tabelle mit allen die es gibt.
Damit zu vergleichen erfordert wieder einen bißchen anderen Code.
„Cells“ wird dir in der VB-Hilfe erklärt, wie If usw.
Option Explicit
'
'Makro wird automatisch gestartet wenn in irgendeinem Blatt ein Wert geändert wird.
Private Sub Workbook\_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wks As Worksheet, ZeiSD As Long, Zei As Long
'Ist das Blatt "Doppelte Statistik" soll nichts geschehen
If Sh.Name = "Statistik Doppelte" Then Exit Sub
'wenn Blattänderungen außerhalb von A6:H21 soll nichts geschehen.
If Intersect(Target, Range("A6:H21")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
'Alles was in der With-Schleife steht und vorne nur einen Punkt hat
'bezieht sich auf "Doppelte Statistik"
With Worksheets("Statistik Doppelte")
'unterste beschribene eilennummer in Spalte B finden.
ZeiSD = .Cells(.Rows.Count, 2).End(xlUp).Row
'Alles unterhalb von A1:F3 wird gelöscht
If ZeiSD \>= 4 Then .Range("A4:F" & ZeiSD).ClearContents
ZeiSD = 4
'Alle Blätter
For Each wks In Worksheets
'Wenn Blattname ungleich "Doppelte Statistik" dann
If wks.Name "Statistik Doppelte" Then
' für die zeilen 6 bis 21
For Zei = 6 To 21
' Steht in der 8ten Spalte, also H ein Wert \>=1? dann...
If wks.Cells(Zei, 8) \>= 1 Then
.Cells(ZeiSD, 1) = wks.Cells(1, 1)
.Cells(ZeiSD, 2) = wks.Cells(1, 2)
.Cells(ZeiSD, 3) = wks.Cells(Zei, 1)
.Cells(ZeiSD, 4) = wks.Cells(Zei, 8)
.Cells(ZeiSD, 5) = wks.Cells(Zei, 4)
.Cells(ZeiSD, 6) = .Cells(ZeiSD, 4) \* .Cells(ZeiSD, 5)
ZeiSD = ZeiSD + 1
End If
Next Zei
End If
Next wks
End With
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
Danke das ist echt nett,
mich wurmt das Thema Makro und VBA so, dass ich mir echt versuche das beizubringen. Ist ja auch gar nicht so schlecht (komme ja auch aus der kaufmännsichen IT Branche, da kann das ja von Vorteil sein).
Ich danke dir nochmal ganz dolle, dass du mir geholfen hast!
Liebe Grüße
ice