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?
hallo atilla,


:18: 

DANKE DANKE DANKE :100: 


:45:

Vielen lieben Dank - alles perfekt so !


LG
Angelina
Antworten Top
hallo Atilla,

muß dich nochmals stören Blush 


Mir ist ein Fehler aufgefallen.

Ich habe die Datei nochmals angehängt.
Letzter Stand der Datei.

Also, wenn ich in Spalte AO alle Zahlen summiere komme ich in der Musterdatei
auf 137

Wenn ich nun in der Spalte AQ alle Zahlen summiere komme ich in der Musterdatei
auf 84

Die 137 stimmen ... bei den 84 fehlen einige.

Die Spalte AR zählt auch nur die Trefferposition -
also rote Zahlen aus Spalte N - bis zur Position 11

Es gibt aber ... auch in dieser Musterdatei ... Positionen
wie z.B. die Zeile 28 oder 29 wo in der Spalte N die
Position 13 oder 14 rot ist.

Da denke ich liegt der kleine Fehler ... es werden nicht alle
Positionen in der Spalte AR dargestellt.

Könntest du da bitte nochmals drüberschauen?

Danke nochmals

LG
Angelina


Angehängte Dateien
.xls   Zuletzt-20-04-2016.xls (Größe: 156 KB / Downloads: 5)
Antworten Top
Hallo Angelina,

dann müsste ich jetzt schreiben, dass ich Dich nicht richtig verstanden hatte.
Tue ich aber nicht. Besser ist, dann hast Du es falsch erklärt. :19:

Du hast Glück, dass ich meine eigene Handschrift im Code lesen konnte und dass ich so viele Kommentare reingeschrieben hatte.
Sonst hätte ich mich jetzt nicht so schnell wieder reindenken können.

In der Hoffnung, dass ich es jetzt richtig verstanden habe, sollte der folgende Code Deine Wünschen entsprechen.

Code:
Sub zählen_Ati()
Dim lngLetzteZeile As Long, pp As Long, n As Long, lngP As Long, x, zz
Dim i As Long, j As Long
Dim strgSammlung As String
Dim vantQ As Variant
Dim lngZ As Long
Dim arrZ()
Dim vntF
Dim strgZ As String
Dim loStartTime As Long
loStartTime = GetTickCount
Tabelle1.Select

Application.ScreenUpdating = False
zählen
lngZ = Application.CountIf(Range("D:D"), ">0")
lngLetzteZeile = LetzteBeschriebeneZeile(Range("D:I"))
vantQ = Range("O1:AL" & lngLetzteZeile)
Columns("AN").ClearContents
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, "#"))
     zz = Application.Max(zz, n)
     ReDim Preserve arrZ(lngMax - 1, 0 To zz + 1)
     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
       arrZ(pp, 0) = arr(pp) + 1
       arrZ(pp, n) = n
     Else
       arrZ(pp, n) = ""
     End If
   Next n
 Else
   Cells(arr(pp) + 1, 40) = 0
 End If
 strgSammlung = ""
 strgZ = ""
Next pp

Columns("AQ:AS").ClearContents
With Sheets("Tabelle2")
 .Cells.Clear
 .Cells(2, 1).Resize(pp, zz) = (arrZ)
 .Cells(1, 2).Resize(1, zz).FormulaLocal = "=Anzahl(B2:" & Cells(pp + 1, 2).Address(0, 0) & ")"
 .Cells(pp + 2, 2).Resize(1, zz).FormulaLocal = "=Max(B2:" & Cells(pp + 1, 2).Address(0, 0) & ")"
 .Cells(pp + 3, 2).Resize(1, zz).FormulaLocal = "=Vergleich(0;B1:" & .Cells(pp + 1, 2).Address(0, 0) & ";-1)"
 vntF = .Cells(1, 1).Resize(pp + 3, zz + 1)
 .Cells(1, 2).Resize(pp + 1, zz).Sort key1:=.Cells(1, 2), Order1:=xlDescending, Header:=xlNo, Orientation:=xlLeftToRight
 i = 1
 For n = 2 To zz + 1
   If .Cells(1, n) > 0 Then
     Cells(i, 43) = .Cells(1, n)
     Cells(i, 44) = .Cells(pp + 2, n)
     Cells(i, 45) = .Cells(.Cells(pp + 3, n), 1) - lngZ
     i = i + 1
   End If
 Next n

End With


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

End Sub


Mit den neuen Vorgaben, konnte ich den Code um min 7 Zeilen kürzen.

Sollte das auch nicht richtig sein, dann sende mir Deine Kontodaten. Denn dann ist es einfacher, wenn ich Dir die Summe des Lottojackpots überweise. :16:
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • Angelina
Antworten Top
hallo atilla,
ja ... mein Fehler
Danke ... Danke ...
ist richtig so !!!
LG
Angelina
Antworten Top


Gehe zu:


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