Zellen differenziert auslesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub aaa() Dim c As Long, i, lc As Long, tmp() lc = Cells(1, Columns.Count).End(xlToLeft).Column ReDim tmp(lc) tmp(i) = 1 For c = 2 To lc If Cells(1, c).Interior.Color > Cells(1, c - 1).Interior.Color Then i = i + 1 End If tmp(i) = tmp(i) + 1 Next c ReDim Preserve tmp(i) MsgBox Join(tmp, ",") End Sub

... Mich fasziniert, was mit Excel alles möglich ist und ich habe Dank Rudi und meines Sohnes wieder viel hinzugelernt. Drum "spinne" ich jetzt mal mein Vorhaben etwas weiter.

Mit dem obigen Modul habe ich im Grunde mein oberstes Etappenziel erreicht. Die fortführenden Schritte habe ich manuell gelöst, bis zum Endziel waren noch 10 weitere notwendig. Vielleicht (ich möchte aber bitte nicht unverschämt rüberkommen, ist reines Interesse und "Magie" und Neugier) könnte man hiervon zumindest einige noch in dem Modul platzieren? Ich schreibe mal meine Wunschliste auf, wenn ich keine Antwort mehr bekomme, dann geht das völlig in Ordnung.

1. Könnte man die Blöcke auch von rechts nach links auszählen lassen?
2. Könnten die ausgezählten Werte in einzelnen Spalten/nebeneinanderliegenden Zellen platziert werden (statt mit Komma getrennt)?
3. Wenn ja, könnte dann nach jeder Spalte/Zelle eine Leerspalte eingefügt werden?
4. Könnten die Zeilen dann noch gespiegelt werden (erste Zeile als letzte und letzte als erste ...)?

Wie geschrieben, das sind absolute Wunschvorstellungen, ich bin auch bis jetzt absolut happy und bekomme diese Punkte auch manuell auf die Reihe.

Herzliche Grüße
Anja

Hallo,
geht alles.

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

mit , getrennt: =Bloecke(A1:P1)
mit , getrennt und gespiegelt: =Bloecke(A1:P1;1)
Einzelzellen: =Bloecke(A1:P1;;1)
Einzelzellen mit Lücke: =Bloecke(A1:P1;;1;1)
Einzelzellen mit Lücke, gespiegelt: =Bloecke(A1:P1;1;1;1)

Gruß
Rudi

Function Bloecke(rngB As Range) Dim c As Long, i As Long, lc As Long, tmp() 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, ",") End Function

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen differenziert auslesen

8 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)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread