Clever-Excel-Forum - Ursprüngliche Zahlen finden?

Seiten: 1 2 3 4 5 6 7 8 9 10 11 12 13 14

hallo atilla,

:18:

DANKE DANKE DANKE :100:

:45:

Vielen lieben Dank - alles perfekt so !

LG
Angelina

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

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:

hallo atilla,
ja ... mein Fehler
Danke ... Danke ...
ist richtig so !!!
LG
Angelina

Seiten: 1 2 3 4 5 6 7 8 9 10 11 12 13 14