VBA-Problem bei meinem EXCEL-Tool

[Conquistador]

Hallo Meitserkeks

folgendes Makro macht das gleiche, ist aber kürzer:

'Zählen Zeile 2 aus Range A mit Zeilen aus Range B
Range("V2").Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(COUNTIF(RC[-21]:RC[-10],RC[-7]:RC[-2]))"

Range("V3").Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(COUNTIF(R[-1]C[-21]:R[-1]C[-10],RC[-7]:RC[-2]))"

Range("V4").Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(COUNTIF(R[-2]C[-21]:R[-2]C[-10],RC[-7]:RC[-2]))"

'Zählen Zeile 3 aus Range A mit Zeilen aus Range B
Range("W2").Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(COUNTIF(R[1]C[-22]:R[1]C[-11],RC[-8]:RC[-3]))"

Range("W3").Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(COUNTIF(RC[-22]:RC[-11],RC[-8]:RC[-3]))"

Range("W4").Select
ActiveCell.FormulaR1C1 = "=SUMPRODUCT(COUNTIF(R[-1]C[-22]:R[-1]C[-11],RC[-8]:RC[-3]))"
End Sub

Gruß Peter

[Meisterkeks]

Original von Peter K.
Also die Zahlenreihen in der RANGE A ?
JA

Range B = Ziehungszahlen ?
JA

Wird die RANGE A mal erweitert auf mehr als 12 Zahlen ?
wenn, dann max. auf 13, 14 oder 15

siehe rote Antworten

[Meisterkeks]

Original von Conquistador
Hallo Meitserkeks

folgendes Makro macht das gleiche, ist aber kürzer:


Gruß Peter

Danke, bin gespannt ob eine Schleifen-Lösung möglich ist :was:

[Peter K.]

Hi Peter und Meisterkeks,

das ist jetzt aber die Lösung 2 - -

wo die Formel durch die VBA-Routine

direkt ins Arbeitsblatt geschrieben wird.


Soll jetzt mit diesem Lösungsansatz weitergearbeitet werden ?

Beste Grüße

Peter K.
.

[Meisterkeks]

Original von Peter K.
Hi Peter und Meisterkeks,

das ist jetzt aber die Lösung 2 - -

wo die Formel durch die VBA-Routine

direkt ins Arbeitsblatt geschrieben wird.


Soll jetzt mit diesem Lösungsansatz weitergearbeitet werden ?

Beste Grüße

Peter K.
.

Nein, bei der Schleifenlösung dachte ich an die Lösung, dass das Ergebnis eingetragen wird

[Peter K.]

Hallo Meisterkeks, hallo Peter,


nach dem einiges an Gehirnschmalz verbraten wurde, hier nun mein Lösungsvorschlag :

Das Ergebnis :




Und der Programmcode :




Und hier der Code zum kopieren :


Sub Auswertung()

Dim iSchleife_A As String
Dim kSchleife_B As String
i = 2 ' Zeilenzähler Block A
k = 2 ' Zeilenzähler Block B
m = 22 ' Spaltenzähler Ergebnisse
n = 0 ' Zeilenzähler Ergebnisse
p = 0 ' Versatzkorrektur
Letzte_Testreihe_A = 21 ' Block A
Letzte_Testreihe_B = 41 ' Block B
iSchleife_A = i
kSchleife_B = k

For i = 2 To Letzte_Testreihe_A

For k = 2 To Letzte_Testreihe_B

iSchleife_A = i
kSchleife_B = k

Worksheets(4).Cells(i + n, m) = _
Application.WorksheetFunction.CountIf(Range("A" + iSchleife_A + ":" + "L" + iSchleife_A), Range("O" + kSchleife_B)) + _
Application.WorksheetFunction.CountIf(Range("A" + iSchleife_A + ":" + "L" + iSchleife_A), Range("P" + kSchleife_B)) + _
Application.WorksheetFunction.CountIf(Range("A" + iSchleife_A + ":" + "L" + iSchleife_A), Range("Q" + kSchleife_B)) + _
Application.WorksheetFunction.CountIf(Range("A" + iSchleife_A + ":" + "L" + iSchleife_A), Range("R" + kSchleife_B)) + _
Application.WorksheetFunction.CountIf(Range("A" + iSchleife_A + ":" + "L" + iSchleife_A), Range("S" + kSchleife_B)) + _
Application.WorksheetFunction.CountIf(Range("A" + iSchleife_A + ":" + "L" + iSchleife_A), Range("T" + kSchleife_B))

n = n + 1

Next k

m = m + 1: p = p + 1: n = 0 - p

Next i

Range("A2").Select: Range("V2").Select

End Sub

Sub Löschen()



Worksheets(4).Range(Cells(2, 22), Cells(41, 41)).Select

Selection.Clear

End Sub


Ich habe nur sehr oberflächlich getestet - - trotzdem hoffe ich, daß kein Kinken eingebaut ist.


Den abschließenden Test überlasse ich Dir.


@Meisterkeks : Ich schicke Dir eine eMail mit Excel-Anhang


Beste Grüße

Peter K.
.

[Meisterkeks]

WAAAAHHHHNSINN - die geniale und perfekte Lösung!

Die ersten groben Tests ohne Probleme - am Wochenende gibts den Härtetest :lol1:

Auf alle Fälle schon mal allerbesten Dank!

[Meisterkeks]

Original von Meisterkeks
Die ersten groben Tests ohne Probleme - am Wochenende gibts den Härtetest :lol1:

Härtetests perfekt bestanden - keine versteckten Mängel entdeckt

Besten Dank nochmals an Peter K.