Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
396to400
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
396to400
396to400
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Statistische Daten auswerfen

Statistische Daten auswerfen
16.03.2004 14:37:16
Elmar
Hallo Profis,
nun versuche ich schon seit Tagen was hinzubekommen, aber es klappt einfach nicht und im Archiv bzw. auf derCD finde ich auch nichts passendes.
Ich habe eine Tabelle mit Name LVB. Diese Tabelle enthält immer eine unterschiedliche Zahl an Datensätzen (Zeilen). Nun möchte ich über ein Makro hinbekommen, dass es mir einige statistische Daten auswirft und in einen Kasten oder in Zeilen jeweils unterhalb des benutzen Bereiches schreibt. Die Zeile 1 und 2 sind immer Überschrift und sollen ausgespart werden.
Nun zum Bespiel: Ich habe in Spalte H z.B. ST = Standard, Ko = Kompakt, Gr = Groß und Ma = Maxi. Nun soll mir das Makro raufinden, wievie im benutzen Bereich von jeder Sorte(ST, Ko, Gr, Ma) da sind.
In Spalte D habe ich Teilnehmernummern. hier möchte ich nach gleichem Schema rausfinden, wieviel Datensätze auf den jeweiligen Teilnehmer kommen und auch in einen Kasten etc. schreiben.
Kann mir jemand helfen? Wäre echt froh drum...
Danke Elmar

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Statistische Daten auswerfen
17.03.2004 02:08:48
Hans W. Herber
Hallo Elmar,
das wäre schon ein ziemlicher Zufall gewesen, wenn Du genau zu diesem speziellen Problem eine Lösung auf der CD gefunden hättest, oder?
Du solltest zuerst eine grundsätzliche Überlegung anstellen: Sollte man das Problem nicht einfach mit Formeln lösen?
Sieh Dir dazu bitte mal folgende Beispielarbeitsmappe an:
AW: Statistische Daten auswerfen
17.03.2004 12:43:34
Elmar
Hallo Hans,
mit Deiner Formel klappt es in fast allen Fällen hier. Nur in einer Spalte habe ich etwa 100 verschiedene Teilnehmernummern und ich muß immer wissen, wie oft einer in der Tabelle vorkommt. Das ist doch mit einer Formel fast nicht möglich.
Deshalb habe ich mir aus vielen Beiträgen ein Makro gebastelt bzw. mir auch noch helfen lassen, dass das Problem lösen könnte.
Nun möchte ich das aber 2 mal laufen lassen (Teilnehmernummer) und (BZA-Niederlassungen). Das klappt auch gut, wenn ich dann das Ergebnis in die erste freie Zeile schrieben lasse. Doch nach dem zweiten Lauf bringt es das erste Ergebnis zusätzlich wieder.
Woran kann denn das liegen?
Alles andere kann ich mit Deiner Formel prima machen!
'Abfrage nach Teilnehmernummer
For a = 3 To MAXZeilen
For b = 1 To MAXUnt
If Cells(a, 4).Value = Eintrag(b, 0) Then GEF = True
Next b
If GEF = False Then 'Wenn Eintrag noch nicht bearbeitet dann bearbeiten
Einträge = Einträge + 1
Eintrag(Einträge, 0) = Cells(a, 4).Value
For b = 1 To MAXZeilen
If Eintrag(Einträge, 0) = Cells(b, 4).Value Then Zähler = Zähler + 1
Next b
Eintrag(Einträge, 1) = Zähler
Zähler = 0
End If
GEF = False
Next a
'Meldung
For a = 1 To Einträge
TextBox = TextBox & Eintrag(a, 0) & " = " & Eintrag(a, 1) & " mal" & Chr(10)
Next a
''suchen nach der ersten freien Zelle
iRow = Sheets("A1").Cells(Rows.Count, 1).End(xlUp).Row + 3
Sheets("A1").Cells(iRow, 1).Select
'Ausgabe in Zelle
Sheets("A1").Cells(iRow, 1).Value = TextBox & Eintrag(a, 0) & " = " & Eintrag(a, 1) & " mal" & Chr(10)

For a = 3 To MAXZeilen
For b = 1 To MAXUnt
If Cells(a, 8).Value = Eintrag(b, 0) Then GEF = True
Next b
If GEF = False Then 'Wenn Eintrag noch nicht bearbeitet dann bearbeiten
Einträge = Einträge + 1
Eintrag(Einträge, 0) = Cells(a, 8).Value
For b = 1 To MAXZeilen
If Eintrag(Einträge, 0) = Cells(b, 8).Value Then Zähler = Zähler + 1
Next b
Eintrag(Einträge, 1) = Zähler
Zähler = 0
End If
GEF = False
Next a
'Meldung
For a = 1 To Einträge
Texti = Texti & Eintrag(a, 0) & " = " & Eintrag(a, 1) & " mal" & Chr(10)
Next a

MsgBox Texti, vbInformation, "Standard - Kompakt- Groß- oder Maxiformat:"

Schon mal danke für´s Drüberschauen
Grüße
Elmar
Anzeige
AW: Statistische Daten auswerfen
18.03.2004 04:36:47
Hans W. Herber
... Du musst die Stringvariable mit der Meldung nach dem ersten Durchluaf wieder auf einen Leerstring zurücksetzen.
Gruss hans
AW: Statistische Daten auswerfen
18.03.2004 09:00:32
Elmar
Hallo Hans,
irgendwie klappt das nicht bei mir.
Kannst Du mir ein kleines Muster schreiben, wie ich die Meldung zurücksetzten kann. Bei mir bleibt alles weiterhin im Speicher
Danke schon mal
Grüße
Elmar
AW: Statistische Daten auswerfen
18.03.2004 09:10:01
Hans W. Herber
... nachdem Du die Meldung angezeigt hast, setze zurück mit:
Texti = ""
gruss hans
AW: Statistische Daten auswerfen
18.03.2004 09:24:00
Elmar
Hallo Hans,
ich hoffe, ich nerve Dich nicht zu arg...
aber das versuche ich schon ständig (allerdings hier mit Textbox = ""), aber es klappt nicht.
Ich habe Dir mal den ganzen Code angehängt. Kann es sein, dass es nicht geht, weil ich die Werte in das Tabellenblatt schreiben lasse?

Sub Sortierung_nach_Einlieferung_ueber_BK_ohneMaske()
Dim MAXZeilen As Integer 'Maximale Zeilenzahl
Dim MAXUnt As Integer 'Maximale unterschiedliche Eintragungen
Dim Eintrag() As String 'Einträge
Dim Einträge As Integer 'Anzahl der Einträge in Variable Eintrag()
Dim Zähler As Integer 'Anzahl der mehrfachen Einträge
Dim a As Integer 'Schmiermerker
Dim b As Integer 'Schmiermerker
Dim c As Integer 'Schmiermerker
Dim GEF As Boolean 'Schmiermerker
Dim TextBox As String 'Merker für Meldungsausgabe
MAXZeilen = 100
MAXUnt = 50
ReDim Eintrag(1 To MAXUnt, 0 To 1) As String '0 = Zeichenfolge, 1=Anzahl
Dim datAnfang
Dim datEnde
Dim Blatt As Object
Set Blatt = ActiveSheet
On Error GoTo errorhandler
datAnfang = InputBox("Hier das ANFANGSDATUM eingeben:" & Chr(10) & Chr(10) & Chr(10) & Chr(10) & _
"Bitte Datum im Zahlenformat (z.B. 1.1.03 oder 01.01.03) eingeben", "Sortieren nach Datum")
If datAnfang = ("") Then Exit Sub
If IsDate(datAnfang) = False Then GoTo errorhandler
datEnde = InputBox("Hier das ENDDATUM eingeben:" & Chr(10) & Chr(10) & Chr(10) & Chr(10) & _
"Bitte Datum im Zahlenformat (z.B. 31.1.03 oder 09.01.03) eingeben", "Sortieren nach Datum")
If datEnde = ("") Then Exit Sub
If IsDate(datEnde) = False Then GoTo errorhandler
Range("K2").Value = "XX"
Range("N2").Value = "XX"
Range("W2").Value = "XX"
Range("AA2").Value = "XX"
Range("I3").AutoFilter Field:=9, Criteria1:=">=" & _
CDbl(DateValue(datAnfang)), Operator:=xlAnd, _
Criteria2:="<=" & CDbl(DateValue(datEnde))
ActiveWindow.ScrollRow = 1
Selection.AutoFilter Field:=6, Criteria1:="BKa"
's = Application.WorksheetFunction.Subtotal(3, Range("A3:A" & ActiveSheet.UsedRange.Rows.Count))
'MsgBox s & " verzögerte Briefe im abgefragten Zeitraum!"
'End
On Error Resume Next
Application.DisplayAlerts = False
For Each Blatt In Sheets
If Blatt.Name = "A1" Or Blatt.Name = "A2" _
Or Blatt.Name = "A3" Or Blatt.Name = "A4" Then
Blatt.Delete
End If
Next Blatt
Application.DisplayAlerts = True
ActiveCell.CurrentRegion.SpecialCells(xlVisible).Copy
Worksheets.Add.Name = "A1"
Range("A1").Select
ActiveSheet.Paste
Columns.AutoFit
Columns("A:A").Select
Selection.ColumnWidth = 4
Columns("B:B").Select
Selection.ColumnWidth = 4
Columns("K:K").Select
Selection.ColumnWidth = 1
Columns("N:N").Select
Selection.ColumnWidth = 1
Columns("O:O").Select
Selection.ColumnWidth = 4
Columns("P:P").Select
Selection.ColumnWidth = 4
Columns("W:W").Select
Selection.ColumnWidth = 1
Columns("AA:AA").Select
Selection.ColumnWidth = 1
Columns("AB:AB").Select
Selection.ColumnWidth = 4
Columns("AC:AC").Select
Selection.ColumnWidth = 4
Range("A1").Select
Sheets("A1").Activate
ActiveSheet.Move After:=Sheets(Sheets.Count)
'w = ActiveSheet.UsedRange.Rows.Count
'  w = w - 2
' MsgBox w & " verzögerte Briefe mit Einlieferung über den Briefkasten!" & Chr(13) & Chr(13) & _
' "Bitte beachten Sie, dass die soeben erstellte Arbeitsmappe" & Chr(13) & _
' "nicht gespeichert ist, wenn die Datei geschossen wird."
' Range("a1").Select
'Application.ScreenUpdating = False
Sheets("E70").Activate
Selection.AutoFilter Field:=7
Sheets("E71").Activate
Selection.AutoFilter Field:=7
Sheets("E72").Activate
Selection.AutoFilter Field:=7
Sheets("E73").Activate
Selection.AutoFilter Field:=7
Sheets("E74").Activate
Selection.AutoFilter Field:=7
Sheets("E75").Activate
Selection.AutoFilter Field:=7
Sheets("E76").Activate
Selection.AutoFilter Field:=7
Sheets("E77").Activate
Selection.AutoFilter Field:=7
Sheets("E78").Activate
Selection.AutoFilter Field:=7
Sheets("E79").Activate
Selection.AutoFilter Field:=7
Sheets("E80").Activate
Selection.AutoFilter Field:=7
Sheets("E81").Activate
Selection.AutoFilter Field:=7
Sheets("E82").Activate
Selection.AutoFilter Field:=7
Sheets("E83").Activate
Selection.AutoFilter Field:=7
Sheets("E84").Activate
Selection.AutoFilter Field:=7
Sheets("E85").Activate
Selection.AutoFilter Field:=7
Sheets("E86").Activate
Selection.AutoFilter Field:=7
Sheets("E87").Activate
Selection.AutoFilter Field:=7
Sheets("E88").Activate
Selection.AutoFilter Field:=7
Sheets("E89").Activate
Selection.AutoFilter Field:=7
Sheets("E90").Activate
Selection.AutoFilter Field:=7
Sheets("E91").Activate
Selection.AutoFilter Field:=7
Sheets("E92").Activate
Selection.AutoFilter Field:=7
Sheets("E93").Activate
Selection.AutoFilter Field:=7
Sheets("E94").Activate
Selection.AutoFilter Field:=7
Sheets("E95").Activate
Selection.AutoFilter Field:=7
Sheets("E96").Activate
Selection.AutoFilter Field:=7
Sheets("E97").Activate
Selection.AutoFilter Field:=7
Sheets("A1").Activate
Application.ScreenUpdating = True
'Beginn der Überschriftszeile
iRow = Sheets("A1").Cells(Rows.Count, 1).End(xlUp).Row + 2
Sheets("A1").Cells(iRow, 1).Select
Sheets("A1").Cells(iRow, 1).Value = "Einlieferung über Briefkasten in abgefragten Zeitraum"
i = ActiveCell.Row
y = ActiveCell.Column
Range(Cells(i, y), Cells(i + 0, y + 23)).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 3
Selection.Font.ColorIndex = 2
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.RowHeight = 15
.Orientation = 0
.WrapText = True
.ShrinkToFit = False
.MergeCells = True
End With
'Ende der Überschriftszeile
'Abfrage nach Teilnehmernummer
For a = 3 To MAXZeilen
For b = 1 To MAXUnt
If Cells(a, 4).Value = Eintrag(b, 0) Then GEF = True
Next b
If GEF = False Then 'Wenn Eintrag noch nicht bearbeitet dann bearbeiten
Einträge = Einträge + 1
Eintrag(Einträge, 0) = Cells(a, 4).Value
For b = 1 To MAXZeilen
If Eintrag(Einträge, 0) = Cells(b, 4).Value Then Zähler = Zähler + 1
Next b
Eintrag(Einträge, 1) = Zähler
Zähler = 0
End If
GEF = False
Next a
'Meldung
For a = 1 To Einträge
TextBox = TextBox & Eintrag(a, 0) & " = " & Eintrag(a, 1) & " mal" & Chr(10)
Next a
''suchen nach der ersten freien Zelle
iRow = Sheets("A1").Cells(Rows.Count, 1).End(xlUp).Row + 3
Sheets("A1").Cells(iRow, 1).Select
'Ausgabe in Zelle
Sheets("A1").Cells(iRow, 1).Value = TextBox & Eintrag(a, 0) & " = _
" & Eintrag(a, 1) & " mal" & Chr(10)
'suchen nach der letzten benutzen Zelle
i = Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Cells(i, 1).Select
i = ActiveCell.Row
y = ActiveCell.Column
Range(Cells(i, y), Cells(i + 0, y + 2)).Select
'letzte benutzet Zelle und zwei danebenliegende markieren und verbinden
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.RowHeight = 300
.Orientation = 0
.ShrinkToFit = False
.MergeCells = True
End With
ActiveCell.Offset(0, 1).FormulaR1C1 = _
"=""Standard: ""&COUNTIF(R3C24:R50000C24,""ST"")&""" & _
Chr(10) & _
"Kompakt: ""&COUNTIF(R3C24:R50000C24,""Ko"")&""" & _
Chr(10) & """&" & Chr(10) & _
"""Groß: ""&COUNTIF(R3C24:R50000C24,""Gr"")&""" & _
Chr(10) & """&" & Chr(10) & _
"""Maxi: ""&COUNTIF(R3C24:R50000C24,""Ma"")"
ActiveCell.Offset(0, 1).Select
i = ActiveCell.Row
y = ActiveCell.Column
Range(Cells(i, y), Cells(i + 0, y + 1)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.RowHeight = 300
.Orientation = 0
.WrapText = True
.ShrinkToFit = False
.MergeCells = True
End With
ActiveCell.Offset(0, 1).FormulaR1C1 = _
"=""Montag: ""&COUNTIF(R3C8:R50000C8,""Mo"")&""" & Chr(10) & _
"Dienstag: ""&COUNTIF(R3C8:R50000C8,""Di"")&""" & Chr(10) & """&" & Chr(10) & _
"""Mittwoch: ""&COUNTIF(R3C8:R50000C8,""Mi"")&""" & Chr(10) & """&" & Chr(10) & _
"""Donnerstag: ""&COUNTIF(R3C8:R50000C8,""Do"") &""" & Chr(10) & """&" & Chr(10) & _
"""Freitag: ""&COUNTIF(R3C8:R50000C8,""Fr"") &""" & Chr(10) & """&" & Chr(10) & _
"""Samstag: ""&COUNTIF(R3C8:R50000C8,""Sa"")&""" & Chr(10) & """&" & Chr(10) & _
"""Sonntag: ""&COUNTIF(R3C8:R50000C8,""So"")"
ActiveCell.Offset(0, 1).Select
i = ActiveCell.Row
y = ActiveCell.Column
Range(Cells(i, y), Cells(i + 0, y + 2)).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.RowHeight = 300
.Orientation = 0
.WrapText = True
.ShrinkToFit = False
.MergeCells = True
End With
'Abfrage nach Teilnehmernummer
For a = 3 To MAXZeilen
For b = 1 To MAXUnt
If Cells(a, 9).Value = Eintrag(b, 0) Then GEF = True
Next b
If GEF = False Then 'Wenn Eintrag noch nicht bearbeitet dann bearbeiten
Einträge = Einträge + 1
Eintrag(Einträge, 0) = Cells(a, 9).Value
For b = 1 To MAXZeilen
If Eintrag(Einträge, 0) = Cells(b, 9).Value Then Zähler = Zähler + 1
Next b
Eintrag(Einträge, 1) = Zähler
Zähler = 0
End If
GEF = False
Next a
'Meldung
For a = 1 To Einträge
TextBox = TextBox & Eintrag(a, 0) & " = " & Eintrag(a, 1) & " mal" & Chr(10)
Next a
MsgBox TextBox, vbInformation, "Standard - Kompakt- Groß- oder Maxiformat:"
End
errorhandler:
Beep
MsgBox "Keine zulässiges Datum! Try again!!", , "Falsche Eingabe"
End Sub


Danke und Grüße
Elmar
Anzeige
AW: Statistische Daten auswerfen
18.03.2004 09:47:51
Hans W. Herber
... nein, tut mir leid, in dieses Monstrum steige ich nicht ein, bei aller Freundschaft.
Ich vermute mal, dass es garnicht um die MessageBox geht, sondern um den Zelleintrag. Nachdem Du den Eintrag vorgenommen hast, setzt Du die Stringvariable - welche auch immer - wie von mir beschrieben zurück.
Gruss hans
AW: Statistische Daten auswerfen
18.03.2004 10:08:26
Elmar
Hallo Hans,
ein Einstieg in das Werk wollte ich auch echt nicht verlangen.
Ich habe nur gedacht, als Profi hättest Du vielleicht sofort ein Fehler gefunden, sozusagen beim Drüberfliegen.
Was Du bzw. das Forum mir schon geholfen hat ist riesig. Danke dafür.
Wenn´s nicht klappt, werde ich einfach in mehreren Schritten arbeiten. Das ist zwar aufwändiger, aber es geht auch.
Danke nochmal für alles und Grüße
Elmar
Anzeige
AW: Statistische Daten auswerfen
18.03.2004 11:48:44
Bertold
Ist die Frage noch offen?
B.
AW: Statistische Daten auswerfen
18.03.2004 15:36:28
Elmar
Hallo Berthold,
die Frage ist noch offen. Allerdings suche ich nach einer anderen Lösung. Wenn Du aber ohne riesigen Aufwand zu betreiben einen Tipp kennst, dann natürlich gerne.
Grüße
Elmar

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige