• Najnowsze pytania
  • Bez odpowiedzi
  • Zadaj pytanie
  • Kategorie
  • Tagi
  • Zdobyte punkty
  • Ekipa ninja
  • IRC
  • FAQ
  • Regulamin
  • Książki warte uwagi

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

VPS Starter Arubacloud
0 głosów
639 wizyt
pytanie zadane 10 marca 2020 w Visual Basic przez Jarek K. Początkujący (330 p.)
zmienione kategorie 10 marca 2020 przez Arkadiusz Waluk

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

1 odpowiedź

0 głosów
odpowiedź 10 marca 2020 przez areklipno Stary wyjadacz (11,930 p.)
edycja 11 marca 2020 przez areklipno


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

 

komentarz 10 marca 2020 przez Jarek K. Początkujący (330 p.)
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 :)
komentarz 11 marca 2020 przez areklipno Stary wyjadacz (11,930 p.)
Zmodyfikowałem odpowiedź - wydaje mi się, że ten drugi kod powinien Ci wystarczyć.
komentarz 12 marca 2020 przez Jarek K. Początkujący (330 p.)

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

Podobne pytania

+1 głos
2 odpowiedzi 2,091 wizyt
pytanie zadane 19 marca 2021 w Visual Basic przez Jarek K. Początkujący (330 p.)
0 głosów
1 odpowiedź 2,268 wizyt
pytanie zadane 23 września 2017 w Visual Basic przez Adam Domański Początkujący (370 p.)
0 głosów
0 odpowiedzi 1,093 wizyt

92,834 zapytań

141,778 odpowiedzi

320,827 komentarzy

62,164 pasjonatów

Motyw:

Akcja Pajacyk

Pajacyk od wielu lat dożywia dzieci. Pomóż klikając w zielony brzuszek na stronie. Dziękujemy! ♡

Oto polecana książka warta uwagi.
Pełną listę książek znajdziesz tutaj.

Akademia Sekuraka

Niedawno wystartował dodruk tej świetnej, rozchwytywanej książki (około 940 stron). Mamy dla Was kod: pasja (wpiszcie go w koszyku), dzięki któremu otrzymujemy 10% zniżki - dziękujemy zaprzyjaźnionej ekipie Sekuraka za taki bonus dla Pasjonatów! Książka to pierwszy tom z serii o ITsec, który łagodnie wprowadzi w świat bezpieczeństwa IT każdą osobę - warto, polecamy!

...