Zellen differenziert auslesen

Hallo, liebe Forumgemeinde,

ich hatte bereits im August hier unter demselben Betreff Hilfe gesucht und auch gefunden. Rudi Maintaire hatte mir ein tolles Makro geschrieben, welches wunderbar funktionierte. Ich war hellauf begeistert. Jetzt wollte ich es in einer neuen Datei mit gleichem Hintergrund anwenden, aber das Makro zählt die Zellen völlig verkehrt aus. Ich habe eine kleine Beispieldatei hochgeladen, in der ich das besagte Makro eingesetzt habe.

https://www.herber.de/bbs/user/165183.xlsm

Weiß wer Rat? Die Dateien, die ich auszuzählen habe, sind riesig und das Makro hatte mir die tagelange Arbeit im Nu abgenommen.

Hier geht es zu meiner einstigen Fragestellung mit Lösung durch Rudi.

https://www.herber.de/forum/archiv/1940to1944/1943023_Zellen_differenziert_auslesen.html#1

Ich danke euch Profis für Hilfe. Wo liegt das Problem, weshalb es jetzt nicht mehr funktioniert? Habe ich einen Denkfehler oder was falsch gemacht?

Herzliche Vorweihnachtsgrüße
Anja

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
anscheinend ist ein kleiner Fehler im Code.
Sollte wohl If rngB(c).Interior.Color > rngB(c - 1).Interior.Color Then statt If rngB(c).Interior.Color > rngB(c - 1).Interior.Color Then heißen.

Function Bloecke(rngB As Range, _

      Optional Spiegeln As Boolean = False, _

      Optional Einzeln As Boolean = False, _

      Optional Luecke As Boolean = False)

      

  Dim c As Long, i As Long, n As Long, lc As Long, tmp(), vntTmp()

  

  Set rngB = rngB.Resize(1)

  lc = rngB.Cells.Count

  ReDim tmp(lc)

  tmp(i) = 1

    For c = 2 To lc

    If rngB(c).Interior.Color > rngB(c - 1).Interior.Color Then

      i = i + 1

    End If

    tmp(i) = tmp(i) + 1

  Next c

  ReDim Preserve tmp(i)

  Bloecke = Join(tmp, ", ")

  

  If Spiegeln Then

    ReDim vntTmp(i)

    For i = UBound(tmp) To 0 Step -1

      vntTmp(n) = tmp(i)

      n = n + 1

    Next i

    tmp = vntTmp

    Bloecke = Join(tmp, ", ")

  End If

  

  If Einzeln Then

    If Luecke Then

      ReDim vntTmp(UBound(tmp) * 2)

      For i = 0 To UBound(tmp)

        vntTmp((i) * 2) = tmp(i)

      Next i

      For i = 1 To UBound(vntTmp) Step 2

        vntTmp(i) = ""

      Next i

      Bloecke = vntTmp

    Else

      ReDim vntTmp(UBound(tmp))

      For i = 0 To UBound(tmp)

        vntTmp(i) = tmp(i)

      Next i

      Bloecke = vntTmp

    End If

  End If

  

End Function

Gruß aus'm Pott
Udo

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen differenziert auslesen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread