VBA - liczenie komórek o określonym kolorze wypełnienia

Question

Cześć

Jestem początkującym jeśli chodzi o VBA, ale coś tam udaje mi się czasem zrobić. Chciałem napisać taki kod: W komórkach od A1 do A5 mam różne wypełnienia (powiedzmy w dwóch jest zielone, a w trzech czerwone - czyli dwa kolory). W komórce C1 mam wypełnienie zielone, a w C2 czerwone. Chciałem napisać makro, które policzy ile jest takich kolorów w A1:A5 jak w C1, wrzuci je do zmiennej licznik1 i pokaże w komórce C1, następnie policzy ile jest takich kolorów w A1:A5 jak w C2, wrzuci do zmiennej licznik2 i pokaże w komórce C2. Napisałem coś takiego robiąc dwie pętle for next. Intuicja mi mówi, że można to zrobić za pomocą jednej funkcji (jakiejś). Może ktoś ma pomysły? Poniżej kod, który napisałem:

Sub liczenie()

Dim i, licznik1, licznik2 As Integer
licznik1 = 0
licznik2 = 0

    For i = 1 To 5
        If Range("C1").Interior.ColorIndex = Cells(i, 1).Interior.ColorIndex Then
            licznik1 = licznik1 + 1
        End If
            Range("C1").Select
            Range("C1") = licznik1
            
    Next i
    
    For i = 1 To 5
        If Range("C2").Interior.ColorIndex = Cells(i, 1).Interior.ColorIndex Then
            licznik2 = licznik2 + 1
        End If
            Range("C2").Select
            Range("C2") = licznik2
            
    Next i

End Sub

Z góy serdecznie dziękuję za propozycje :)

Answer 1

ja Twój kod ułożyłbym tak i wtedy będzie jedna pętla for.

Sub liczenie()
 
Dim i, licznik1, licznik2 As Integer
licznik1 = 0
licznik2 = 0
 
    For i = 1 To 5
        If Range("C1").Interior.ColorIndex = Cells(i, 1).Interior.ColorIndex Then
            licznik1 = licznik1 + 1
        End If

       If Range("C2").Interior.ColorIndex = Cells(i, 1).Interior.ColorIndex Then
            licznik2 = licznik2 + 1
        End If
      
    Next i
     
    Range("C1") = licznik1
    Range("C2") = licznik2
 
End Sub

Można to zrobić inaczej, ale ten kod co powyżej daje już 50% oszczędności czasu w stosunku do Twojego rozwiązania

 

 

EDIT 11.03

jeśli tak jak piszesz chciałbyś uogólnić można to zrobić tak:

Sub liczenie2()

Dim EndColorIndex, IdWiersz1, IdWiersz2, IdKolumna1, IdKolumna2 As Integer

EndColorIndex = -4142 'niewypełniona kolorem komórka
IdWiersz1 = 1
IdKolumna1 = 1 'kolumna A
IdKolumna2 = 3 'kolumna C

'wyczyszczenie tam gdzie wpisanie
IdWiersz2 = 1
Do While (Cells(IdWiersz2, IdKolumna2).Interior.ColorIndex <> EndColorIndex)
    Cells(IdWiersz2, IdKolumna2) = 0
    IdWiersz2 = IdWiersz2 + 1
Loop


'właściwe wpisanie
Do While (Cells(IdWiersz1, IdKolumna1).Interior.ColorIndex <> EndColorIndex)
    IdWiersz2 = 1

    Do While (Cells(IdWiersz2, IdKolumna2).Interior.ColorIndex <> EndColorIndex)
        If (Cells(IdWiersz1, IdKolumna1).Interior.ColorIndex = Cells(IdWiersz2, IdKolumna2).Interior.ColorIndex) Then
            Cells(IdWiersz2, IdKolumna2) = Cells(IdWiersz2, IdKolumna2) + 1
        End If

        IdWiersz2 = IdWiersz2 + 1
    Loop

    IdWiersz1 = IdWiersz1 + 1
Loop

End Sub

 

Comments

No tak, jest krócej. Jednak jeśli byśmy mieli w kolumnie A 20 komórek a w kolumnie C 10 komórek to ta pętla byłaby za długa. Słownie widziałbym to tak: weź pierwszy kolor z komórki C1, porównaj z każdym w kolumnie A, dodaj do siebie i napisz sumę, następnie weź kolor z komórki C1 i porównaj z każdym z kolumny A, dodaj do siebie i napisz sumę itd. to również wygląda na pętlę. Może jakaś zagnieżdżona? Są tu dwie zmienne a konkretnie numer wiersza w kolumnie A i numer wiersza w kolumnie B. Fajnie byłoby napisać krótki kod bez względu na ilość komórek w obu kolumnach :)

---

Zmodyfikowałem odpowiedź - wydaje mi się, że ten drugi kod powinien Ci wystarczyć.

---

@areklipno, Dobre, i działa :) Super, dzięki. Ale muszę teraz przeanalizować kod (jest trochę bardziej skomplikowany od mojego, aczkolwiek spełnia swoje zadanie) :)