It's not a bug, it's a feature...
06.04.2013 02:06:22
Erich
Hi Jörg,
vermutlich habe ich die Aufgabe doch nicht richtig verstanden.
Die Funktion rechnet schon irgendwie richtig, nur eben nicht das, was du möchtest. :-(
Sie erkennt in den Beispielen die grün bezeichneten Bereiche als längste Serien:
| | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z | AA | AB | AC | AD | AE |
| 3 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | | Fkt | ? |
| 6 | 2 | 1 | 1 | 2 | 0 | 2 | 0 | 0 | 0 | 0 | 2 | 1 | 0 | | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | | 4 | 3 |
| 7 | 0 | 0 | 1 | 0 | 0 | 1 | 0 | 1 | 0 | 1 | 1 | 2 | 1 | | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | | 5 | 2 |
| 8 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 2 | 1 | 1 | 1 | 1 | | 0 | 1 | 1 | 0 | 2 | 1 | 1 | 2 | 2 | 0 | 2 | 2 | 2 | | 4 | 2 |
| Formeln der Tabelle |
| Zelle | Formel | | AD6 | =MaxSerie(B6:N6;P6:AB6) | | AD7 | =MaxSerie(B7:N7;P7:AB7) | | AD8 | =MaxSerie(B8:N8;P8:AB8) |
|
Nun hab ich's kapiert: Es geht dir nicht nur um die längste/kürzeste Serie von Übereinstimmungen.
Die Serien müssen sich auch an genau denselben Positionen befinden.
Ist es dann das hier?
| | A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z | AA | AB | AC | AD | AE |
| 3 | Position | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | | Max | Min |
| 4 | Beispiel 1 | a | b | a | b | c | c | a | c | c | c | a | a | a | | a | b | b | c | b | c | a | c | c | c | a | c | c | | 6 | 2 |
| 5 | Beispiel 2 | a | b | a | b | b | b | a | b | c | b | a | b | a | | b | c | a | c | c | b | c | c | a | b | a | b | a | | 4 | 1 |
| 6 | Beispiel 3 | 2 | 1 | 1 | 2 | 0 | 2 | 0 | 0 | 0 | 0 | 2 | 1 | 0 | | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | | 3 | 1 |
| 7 | Beispiel 4 | 0 | 0 | 1 | 0 | 0 | 1 | 0 | 1 | 0 | 1 | 1 | 2 | 1 | | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | | 2 | 1 |
| 8 | Beispiel 5 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 0 | 2 | 1 | 1 | 1 | 1 | | 0 | 1 | 1 | 0 | 2 | 1 | 1 | 2 | 2 | 0 | 2 | 2 | 2 | | 2 | 1 |
| Formeln der Tabelle |
| Zelle | Formel | | AD4 | =MaxSerie(B4:N4;P4:AB4) | | AE4 | =MinSerie(B4:N4;P4:AB4) |
|
Und hier die Codes:
Option Explicit
Function MaxSerie(rngT As Range, rngV As Range)
Dim lngT As Long, mm As Long, tt As Long, ii As Long
lngT = rngT.Cells.Count
If lngT = rngV.Cells.Count Then
For mm = lngT To 1 Step -1
For tt = 1 To lngT - mm + 1
For ii = 0 To mm - 1
If rngT(tt + ii) rngV(tt + ii) Then Exit For
Next ii
If ii = mm Then MaxSerie = mm: Exit Function
Next tt
Next mm
Else
MaxSerie = xlErrNA
End If
End Function
Function MinSerie(rngT As Range, rngV As Range)
Dim lngT As Long, mm As Long, tt As Long, ii As Long
Dim arT(), ee As Long
Const varW = "#äö"
lngT = rngT.Cells.Count
If lngT = rngV.Cells.Count Then
ReDim arT(1 To lngT)
For tt = 1 To lngT
arT(tt) = rngT(tt)
Next tt
For mm = lngT To 1 Step -1
For tt = 1 To lngT - mm + 1
For ii = 0 To mm - 1
If arT(tt + ii) = varW Or _
arT(tt + ii) rngV(tt + ii) Then Exit For
Next ii
If ii = mm Then
ee = mm
For ii = 0 To mm - 1
arT(tt + ii) = varW
Next ii
End If
Next tt
Next mm
MinSerie = ee
Else
MinSerie = xlErrNA
End If
End Function
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
