• 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
574 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 1,929 wizyt
pytanie zadane 19 marca 2021 w Visual Basic przez Jarek K. Początkujący (330 p.)
0 głosów
1 odpowiedź 2,250 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,021 wizyt

92,451 zapytań

141,261 odpowiedzi

319,073 komentarzy

61,853 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

Akademia Sekuraka 2024 zapewnia dostęp do minimum 15 szkoleń online z bezpieczeństwa IT oraz dostęp także do materiałów z edycji Sekurak Academy z roku 2023!

Przy zakupie możecie skorzystać z kodu: pasja-akademia - użyjcie go w koszyku, a uzyskacie rabat -30% na bilety w wersji "Standard"! Więcej informacji na temat akademii 2024 znajdziecie tutaj. Dziękujemy ekipie Sekuraka za taką fajną zniżkę dla wszystkich Pasjonatów!

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!

...