Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Ursprüngliche Zahlen finden?
Angelina,

das steht bei Dir im Codemodul der Tabelle1:


Code:
Private Sub CommandButton3_Click()
Call zählen
End Sub


Wie heißt denn meine Prozedur zum zählen????

Die Function zählen ist zum feststellen der min drei gefärbten Zeilen.

Die Prozedur zählen_Ati ist die zum zählen der Zahlen.

Also hinter die Tabelle:


Code:
Private Sub CommandButton3_Click()
Call zählen_Ati
End Sub



Ich hatte ja schon mal geschrieben, dass Du die Prozedur Benennungen selber nach Wunsch ändern könntest.
Ich habe sie für mich so benannt, wie ich es eingestellt habe.
Gruß Atilla
Antworten Top
hallo

ist mir eben selbst aufgefallen  :20: 


Sorry :22: 



Messergebnisse und Info bezüglich 
Zitat:Zu Deiner weiteren Anfrage muss ich gestehen, dass ich es nicht verstanden habe.

Kannst Du es mit den mir vorliegenden Daten und mit Ergebnissen noch einmal versuchen zu erklären.
kommen morgen !


LG
Angelina
Antworten Top
hallo schauan,
hallo atilla,

Meine Messung:

schauan Musterdatei = 0,156 Sekunden
atilla Musterdatei      = 0,265 Sekunden

schauan meine Datei über 700 Zeilen = 1,622 Sekunden
atilla meine Datei über 700 Zeilen      = 0,312 Sekunden

Veränderung bei schauan in dieser Zeile
'Wenn mindestens 3 Zellen gefaerbt sind, dann
If CountColored(iCnt, colnumbers) >= 1 Then
über meine Datei mit 700 Zeilen = 14,742 Sekunden

Veränderung bei atilla in dieser Zeile
If k >= 1 Then
über meine Datei mit 700 Zeilen = 1,358 Sekunden


@atilla,

Zitat:Zu Deiner weiteren Anfrage muss ich gestehen, dass ich es nicht verstanden habe.

Kannst Du es mit den mir vorliegenden Daten und mit Ergebnissen noch einmal versuchen zu erklären.

Hier mein zweiter Versuch der Erklärung:

Vorwort:
Es geht nur noch um die Spalte N

Stell dir vor das jede einzelne Zahlen in der Spalte N
"getrennt in einer Zelle stehen" würde.

Beispiel:
Zeile 23 mit den Zahlen in der Spalte N
13, 14, 26, 24, 44, 35, 30, 02, 19, 04, 10, 32, 15, 39

Die 13 würde in Spalte A1 stehen
Die 14 würde in Spalte B1 stehen
Die 26 würde in Spalte C1 stehen
usw.
usw.
usw.
Die 39 würde in Spalte N1 stehen

Das meine ich mit "getrennt in einer Zelle stehen".

Analog dazu werden alle weiteren Reihen aus der Spalte N so in dieser
virtuellen Aufteilung stehen.

Wichtig dabei rote Zahlen bleiben rote Zahlen und schwarze Zahlen bleiben schwarz.

Nun hätten wir ein Zahlenraster bestehend aus
Spalten und Zeilen.

Nun kommt die eigentliche Aufgabe:

1.MsgBox
Wieviel rote Zahlen stehen in "dem neuen Raster" in Spalte A
Wieviel rote Zahlen stehen in "dem neuen Raster" in Spalte B
Wieviel rote Zahlen stehen in "dem neuen Raster" in Spalte C
Wieviel rote Zahlen stehen in "dem neuen Raster" in Spalte D
Wieviel rote Zahlen stehen in "dem neuen Raster" in Spalte E
usw.
usw.
Ausgabe in einer MsgBox1


2.MsgBox
Wenn z.B. die Spalte A die am häufigsten roten Zahlen hätte
dann würde die Ausgabe für die 2.MsgBox so sein:

Spalte A = 10 rote Zahlen

Nun suchen wir die zweit häufigste Spalte mit roten Zahlen für die 2.MsgBox
Dazu werden virtuell alle Zeilen - aus unserem Raster - gelöscht, die in der Spalte A eine rote Zahl haben.
Sagen wir es ist die Spalte C die aus den verbleibenden Zeilen die zweit häufigsten roten Zahlen hat.

Bisher haben wir als Ausgabe für die 2.MsgBox dann:
Spalte A = 10 rote Zahlen
Spalte C = 9 rote Zahlen

dann suchen wir die 3.häufigste auf diese gleiche Art
dann suchen wir die 4.häufigste auf diese gleiche Art
usw.
Somit reduziert sich unser Ur-Raster von am Anfang immer mehr bis keine Zeile mehr vorhanden ist.

Am Ende hätten wir eine 2.MsgBox Ausgabe die als Beispiel so stehen würde. Zahlen sind erfunden.
Nur als Beispiel:
Spalte A = 10 rote Zahlen
Spalte C = 9 rote Zahlen
Spalte B = 8 rote Zahlen
Spalte E = 9 rote Zahlen
Spalte D = 10 rote Zahlen
usw.
usw.



Etwas besser verstanden?

LG
Angelina
Antworten Top
Hallo Angelina,

ich habe das jetzt so, dass die Position und Anzahl absteigend sortiert nach Anzahl in AO:AP ausgegeben werden.
Vielleicht reicht Dir das.
Wenn nicht, dann möchtest Du sicher darauf aufbauen. Bitte erklär dann ab diesem Zustand, wie es weitergehen soll.

Die Prozedur zählen_Ati mit folgendem Code ersetzen:


Code:
Option Explicit
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Public arr()
Dim lngMax As Long

Sub zählen_Ati()
 Dim lngLetzteZeile As Long, pp As Long, n As Long, lngP As Long, x
 Dim i As Long, j As Long
 Dim strgSammlung As String
 Dim vantQ As Variant
 Dim dicO As Object
 Set dicO = CreateObject("scripting.dictionary")
 
 Dim loStartTime As Long
 
 loStartTime = GetTickCount
 

 Application.ScreenUpdating = False
 zählen
 lngLetzteZeile = LetzteBeschriebeneZeile(Range("D:I"))
 vantQ = Range("O1:AL" & lngLetzteZeile)
 
 Columns("N").Font.ColorIndex = xlAutomatic
 For pp = 0 To lngMax - 1
 For i = 1 To arr(pp) + 1
   For j = 13 To 24
     If vantQ(i, j) < 6 Then
       If vantQ(i, j) - 1 + i > arr(pp) Or i = arr(pp) + 1 Then
         If InStr(1, strgSammlung, Format(vantQ(i, j - 12), "00"), vbTextCompare) = 0 Then strgSammlung = strgSammlung & "#" & Format(vantQ(i, j - 12), "00")
       End If
     Else
       If vantQ(i, j) + i - 1 > arr(pp) Then
         If InStr(1, strgSammlung, Format(vantQ(i, j - 12), "00"), vbTextCompare) = 0 Then strgSammlung = strgSammlung & "#" & Format(vantQ(i, j - 12), "00")
       End If
     End If
   Next j
 Next i
   If UBound(Split(strgSammlung, "#")) > 0 Then
     Cells(arr(pp) + 1, 40) = UBound(Split(strgSammlung, "#"))
     Cells(arr(pp) + 1, 14) = Replace(Join(Split(strgSammlung, "#"), ", "), ", ", "", 1, 1)
     For n = 1 To UBound(Split(strgSammlung, "#"))
       x = Application.Match(CDbl(Split(strgSammlung, "#")(n)), Range(Cells(arr(pp) + 1, 4), Cells(arr(pp) + 1, 9)), 0)
       If IsNumeric(x) Then
         lngP = n * 3 + n - 3
         Cells(arr(pp) + 1, 14).Characters(Start:=lngP, Length:=2).Font.ColorIndex = 3
         dicO(x) = dicO(x) + 1
       End If
     Next n
   Else
     Cells(arr(pp) + 1, 40) = 0
   End If
   strgSammlung = ""
 Next pp
 'Ausgabe in AO:AR
 Cells(1, 43).Resize(6, 1) = Application.Transpose(dicO.keys)
 Cells(1, 44).Resize(6, 1) = Application.Transpose(dicO.items)
 Cells(1, 43).CurrentRegion.Sort key1:=Cells(1, 44), Order1:=xlDescending, Header:=xlNo
 Erase arr

 Application.ScreenUpdating = True
 MsgBox "Laufzeit " & _
 (GetTickCount - loStartTime) / 1000 & " Sekunden.", _
   vbInformation, "Application.Wait Soll: 3 Sekunden"
   
End Sub

Es sind zwei Zeilen Deklaration und drei Zeilen Code hinzugekommen.
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • Angelina
Antworten Top
hallo atilla,

erstmal danke ... für deine Arbeit !!!

Kurz die Frage:
Die Ausgabe die jetzt gemacht wird in AQ und AR
auf welcher Grundlage meiner Beschreibung ist die nun?

1.MsgBox oder 2.MsgBox ???


LG
Angelina
Antworten Top
hallo atilla,

habe gesehen das es falsch ist ... schade !

Du hast die Position und Anzahl ausgegeben aus dem Bereich D:I ... das ist leider falsch.

Ich hatte geschrieben - es geht nur um die Spalte N

Also die Position und Anzahl der roten Zahlen innerhalb der Spalte N
das ist dann die Ausgabe für 1.MsgBox


LG
Angelina
Antworten Top
Hallo Angelina,

dann änder bitte diese Zeile:

dicO(x) = dicO(x) + 1

so um:

dicO(n) = dicO(n) + 1


Und folgende Zeilen.

  Cells(1, 43).Resize(6, 1) = Application.Transpose(dicO.keys)

  Cells(1, 44).Resize(6, 1) = Application.Transpose(dicO.items)

wie folgt ändern:

  Cells(1, 43).Resize(dicO.Count, 1) = Application.Transpose(dicO.keys)

  Cells(1, 44).Resize(dicO.Count, 1) = Application.Transpose(dicO.items)
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • Angelina
Antworten Top
hallo atilla,


das ist richtig !!!

Das war die Beschreibung für die 1.MsgBox - wobei wir die Ausgabe in der Spalte AQ/AR lassen können.


Kommen wir nun zur 2.MsgBox - wobei wir die Ausgabe hierzu in den Spalten AS/AT machen können.

Bleiben wir bei deiner Musterdatei mit diesen Einstellungen:


AM1 = 5


'VBCodeZeile habe ich geändert von
If k >= 3 Then
in
If k >= 1 Then

Dabei kommt dieses richtige Ergebnis raus:
AQ      AR
1    17
4    15
6    14
9    14
5    13
8    12
3    11
10    11
2    10
7    10
13    3
14    3
11    2
12    2

Für die Ausgabe in den Spalten AS/AT wie folgt:
Wir wissen nun, das die Position 1 genau 17 x vorhanden war (Beispiel von oben)
Somit ist die 1. Ausgabe hier in den Spalten AS/AT auch
1    17

aber die zweite Ausgabe in AS/AT wird nun so berechnet.
Zähle nun alle Zeilen in Spalte N ... als würden die Zeilen nicht existieren, die an Position1 eine rote Zahl hatten.
Also ohne die Zeilen, die zu dem Ergebnis 1 / 17 geführt haben.

Dann erhalten wir ein neues Ergebnis ich nenne es mal a / a

Dann haben wir diese Ausgabe
1 / 17
a / a

Dann zählen wir - als würden diese
1 / 17
a / a
nicht existieren und erhalten für den dritten Durchlauf b / b

1 / 17
a / a
b / b

Dann zählen wir - als würden diese
1 / 17
a / a
b / b
nicht existieren und erhalten für den dritten Durchlauf c / c

usw. usw. bis alle Zeilen aus Spalte N - virtuell nicht mehr vorhanden sind.

Nun besser verstanden :19:


LG
Angelina
Antworten Top
Hallo Angelina,

Kannst Du statt a/a Zahlen einsetzen, die laut Beispiel herauskommen sollten.

Das würde mir wiederum sehr helfen.
Gruß Atilla
Antworten Top
hallo atilla,

siehe Anlage - zwar keine Zahlen aber vielleicht hilft es ja


LG
Angelina


Angehängte Dateien
.xls   Reihen-Reduzieren.xls (Größe: 22 KB / Downloads: 3)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste