Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek dla www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Przypisanie wartości wypełnieniu pola komórki Excel 2007

22 Cze 2009 13:55 17931 19
  • Poziom 9  
    Witam ponownie!

    Mam grafik w formie tabelarycznej (graficzny) który wygląda ogólnie tak że w wierszach są dni a w kolumnach godziny przy czym jedna komórka to 30min. Prowadzenie tego grafiku polega na nadawaniu koloru wypełnieniu poszczególnych komórek po to by po wydrukowaniu jednym rzutem oka wiedzieć w których godzinach w danym dniu jest rezerwacja sali. Czy można nadać wypełnieniu jednej komórki wartość np 0,5h po to by Excel zliczał mi ile godzin w danym dniu zostało wykorzystanych? To było by wyjście do prowadzenia dalszej statystyki a wpisywanie ręczne wartości do poszczególnych komórek jest uciążliwe.
    Pyt 2 to czy można potem wprowadzić funkcję która liczyła by tylko konkretny kolor w tabeli np zielony po to by móc obliczyć ile z danego koloru w miesiącu zostało "wykorzystanych" godzin?
    pozdrawiam i dziękuję.
  • Pomocny post
    Moderator Programowanie
    Moja propozycja: odwróć to.
    Tzn zastosuj formatowanie warunkowe z wypełnieniem kolorem. Wstawiasz (przez przeciągnięcie) powiedzmy jedynki, które łatwo policzyć =LICZ.JEŻELI(A1:A40;"=1") lub zsumować, wynik można podzielić przez dwa, a komórki "same" sczerwienieją lub zzielenieją, jeśli wstawisz liczbę Np 2, którą łatwo policzyć a wynik podzielić przez cztery itd. Stosując kolor czcionki (formatowanie warunkowe) w tym samym kolorze osiągniesz identyczny efekt z aktualnym...
  • Pomocny post
    Poziom 40  
    Tu nasuwa sie jeszcze pytanie ile masz kolorów? Jeżeli do 3 to ok. jak więcej to kłopot.
    Co do reszty zastosuj sugestie kolegi adamas_nt. Ewentualnie zamiast cyfr stosuj litery A, B, C i je zliczaj, dziel przez 2 i i będziesz miał ilość godzin.
  • Poziom 9  
    Hmmm może żeby bardziej zobrazować mój problem wkleję prt sc żebyście mogli zobaczyć jak to wygląda.
    Przypisanie wartości wypełnieniu pola komórki Excel 2007

    Jak widać w kolumnie pierwszej są dni miesiąca a w każdym z nich są trzy sale. Ten grafik służy głównie do graficznego zobrazowania obłożenia sal, kolorów jest znacznie więcej niż 3 a każdy mówi mi na jakich zasadach przygotować salę. Dodatkowo w każdej lini naniesionej w wierszu (jakiś kolor) dopisuję różne informacje potrzebne dla mnie lub pracownika. Chciałem jednak rozbudować funkcjonalność tej tabeli o funkcje liczące i statystyczne ale wyjściem do tego jest nadanie wartości poszczególnym kolorom. Pomysł z wpisywaniem cyfr w każdą komórkę choć skuteczny i stosunkowo prosty to jednak utrudni prowadzenie tego grafiku oraz zaburzy jego i tak nie najlepszą czytelność. Nie wiecie czy przypadkiem jest inny sposób?
    Proszę o pomoc i pozdrawiam
  • Pomocny post
    Poziom 40  
    To tylko za pomocą makr.
    Np. tak:

    Code:
     
    
    Dim kolor(40) As Integer

    For y = 1 To 93
       For x = 1 To 24
            For i = 1 To 40
                If Cells(y + 4, x + 2).Interior.ColorIndex = i Then kolor(i) = kolor(i) + 1
            Next i
       Next x
     Next y
     
     For i = 1 To 40
        Cells(i + 4, 28).Interior.ColorIndex = i
        Cells(i + 4, 28).Interior.Pattern = xlSolid
        If kolor(i) <> 0 Then Cells(i + 4, 29) = kolor(i) / 2
     Next i


    Poniżej działający przykład (trochę trwa liczenie).
    Po dłuższej chwili pojawi się okno "Gotowe" i tyle.

    Chciałem dodać klepsydrę aby się kręciła w trakcie liczenia
    Code:
    fmMousePointerHourGlass
    ale nie wiem na chwilę obecną pod jaki obiekt to podpiąć by to ładnie działało.

    Kod w przykładzie jest "bogatszy w funkcje czyszczące i "okno gotowości"

    Na marginesie dodam że kolor biały (mimo że go nie widać) jest czym innym niż "brak koloru" (index=0)
  • Pomocny post
    Moderator Programowanie
    Trochę między wódkę a zakąskę, ale wtrącę słówko :)

    :arrow: marek003
    A gdyby tak zostawić kolory na stałe w kolumnie "AB" w Twoim arkuszu? Byłaby co najmniej jedna pętla mniej. Z drugiej strony "wyczyścić" z formatów, kolorów i wartości można poleceniem: Range("AB5:AC44").Clear

    I jeszcze jedno. Pętla zapisująca do tablicy wykonuje 93x24x40=89280 powtórzeń. Gdyby zastosować For Each komórki w zakresie byłoby ich 93x24=2232 (jeśli dobrze liczę). Czyli z zapisanymi kolorami w kol "AB"
    Code:
    For Each kom In Range("C5:Z97")
    
        If kom.Interior.ColorIndex > 0 Then
            Cells(kom.Interior.ColorIndex + 4, 29) = Cells(kom.Interior.ColorIndex + 4, 29) + 0.5
        End If
    Next

    I wykonanie obliczeń (tych samych co prawda) w tym przypadku odbywałoby się 40 razy szybciej. Wyłączenie odświeżania (Application.ScreenUpdating) jeszcze ciut przyspieszy wykonywanie kodu.
    Gdyby "kolorową" pętlę, zgodnie z Twoim zamysłem, umieścić na początku mogłoby to wyglądać tak
    Code:
    Private Sub CommandButton1_Click()
    
    Dim kom As Range, i As Integer
    Application.ScreenUpdating = False

    Range("AB5:AC44").Clear

    For i = 1 To 40
        Cells(i + 4, 28).Interior.ColorIndex = i
        Cells(i + 4, 28).Interior.Pattern = xlSolid
    Next i
     
    Cells(4, 28) = "Kolor"
    Cells(4, 29) = "Ilość godzin"

    For Each kom In Range("C5:Z97")
        If kom.Interior.ColorIndex > 0 Then
            Cells(kom.Interior.ColorIndex + 4, 29) = Cells(kom.Interior.ColorIndex + 4, 29) + 0.5
        End If
    Next

    Application.ScreenUpdating = True
    End Sub

    Ad. post niżej. Tak z rozpędu mi się "napisało". Oczywiście "="
  • Pomocny post
    Poziom 40  
    Bardzo trafne spostrzeżenie.
    Skraca to znacznie czas wykonania obliczeń i ta prostota kodu.
    Tylko (przynajmniej u mnie) wyłączenie i włączenie odświeżania trzeba było podać w ten sposób:

    Code:
    Application.ScreenUpdating = False
    
    ...
    Application.ScreenUpdating = True


    Bo inaczej wyskakiwał błąd "Invalid qualifier".

    Poniżej przykład z o wiele szybszym w działaniu makrem kolegi adamasa
  • Pomocny post
    Moderator Programowanie
    I jeszcze drobna poprawka dla E2007 na początku makra, aby sprawdzać wszystkie kolory z palety
    Code:
    Range("AB5:AC60").Clear
    

    For i = 1 To 56
  • Pomocny post
    Poziom 40  
    Zasugerowałem się przyciskiem "kolor wypełnienia" w Excel2003. Jest tam tylko 40 kolorów. Sądziłem że sa po kolei ale jak przed chwila sprawdziłem - myliłem się. W zestawie 40 nie ma np ciemnego żółtego co będzie wpływać na ewentualne obliczenia.
    Więc we wszystkich makrach powyżej należy poprawić 40 na 56.
    (W przypadku pierwszego makra wydłuży to jeszcze obliczenia bo "kolorowa" pętla by przechodziła 56 razy zamiast 40 czyli 93x24x56=124992 powtórzenia więc sugeruje poprawiać drugie rozwiązanie.
  • Poziom 9  
    Powiem szczerze ze jestem pod wrażeniem waszej wiedzy... makra w zasadzie są mi kompletnie obce i w zasadzie to nie wiem jak to ugryźć. Ogólnie to znalazłem funkcję w exelu dot makr ale po skopiowaniu podanej przez Was formuły wyskakuje mi jakiś błąd. nie wiem również jak mam to przenieść na moją tabelę i zdefiniować kolory bo przecież trzeba zidentyfikować poszczególne z nich żeby komp wiedział co liczyć...moglibyście dokładniej wytłumaczyć jak mam ugryźć tą formułę? Z góry dzięki
  • Pomocny post
    Poziom 40  
    Najlepiej by było gdybyś w załączniku podpiął twój przykładowy arkusz.

    Wtedy łatwiej będzie znaleźć ten błąd.

    I jeszcze jedno - na chwilę obecną to makro sprawdza wszystkie kolory z palety więc nie trzeba nic definiować.

    Wklej ten kod między Private Sub ...() a End Sub

    Code:
    Dim kom As Range, i As Integer
    
    Application.ScreenUpdating = False


    Range("AB5:AC60").Clear

    For i = 1 To 56
        Cells(i + 4, 28).Interior.ColorIndex = i
        Cells(i + 4, 28).Interior.Pattern = xlSolid
    Next i
     
    Cells(4, 28) = "Kolor"
    Cells(4, 29) = "Ilość godzin"

    For Each kom In Range("C5:Z97")
        If kom.Interior.ColorIndex > 0 Then
            Cells(kom.Interior.ColorIndex + 4, 29) = Cells(kom.Interior.ColorIndex + 4, 29) + 0.5
        End If
    Next

    Application.ScreenUpdating = True

    i powinno działać ewentualnie zamieść załącznik (jak duży to spakuj i wyłącz prowizję)

    Teraz sobie uświadomiłem że twoja tabela może być całkiem w innym miejscu arkusza a makro jest pod mój przykład więc koniecznie zamieść załącznik w excelu z twoją przykładową tabelą lub popraw odwołania i liczby w powyższym kodzie - dostosuj do twojej tabeli.

    Dodano po 58 [minuty]:

    A dodając jeszcze niewielką pętle pokażą się tylko kolory które uwzględniłeś w tabeli.

    Code:

    Sub Kolory()

    Dim kom As Range, i As Integer
    Application.ScreenUpdating = False

    nazwa = ActiveSheet.Name
    With Sheets(nazwa)

    .Range("AE5:AF60").Clear

    For i = 1 To 56
        .Cells(i + 4, 33).Interior.ColorIndex = i
        .Cells(i + 4, 33).Interior.Pattern = xlSolid
    Next i
     
    For Each kom In .Range("C5:Z97")
        If kom.Interior.ColorIndex > 0 Then
            .Cells(kom.Interior.ColorIndex + 4, 33) = .Cells(kom.Interior.ColorIndex + 4, 33) + 0.5
        End If
    Next

    .Cells(4, 31) = "Kolor"
    .Cells(4, 32) = "Ilość godzin"

    For i = 1 To 56
        If .Cells(i + 4, 33).Value <> "" Then
            x = x + 1
           .Cells(x + 4, 31).Interior.ColorIndex = .Cells(i + 4, 33).Interior.ColorIndex
           .Cells(x + 4, 31).Interior.Pattern = xlSolid
           .Cells(x + 4, 32).Value = .Cells(i + 4, 33).Value
        End If
    Next i

    Range("AG5:AG60").Clear

    End With
    Application.ScreenUpdating = True

    End Sub
  • Pomocny post
    Poziom 40  
    Co do przycisku wywołujacego makro.
    Jeżeli masz więcej arkuszy i będzie to w nich wykorzystywane to kod umieść w module.

    Menu - Widok - paski narzędzi - Visual Basic.
    Na tym pasku wciśnij Edytor Visual Basic.
    Otworzy ci się edytor makr.
    Po lewej stronie będzie okienko "project -VBA project" .
    Znajdź pogrubioną nazwę twojego skoroszytu i prawokliknij na nią.
    Z menu podręcznego wybierz insert - module.
    Pojawi się pod pogrubiona nazwą skoroszytu i nazwami arkuszy w tym skoroszycie nazwa Module1 (jak to będzie pierwszy moduł).
    Dwukrotnie kliknij w Module1.
    W biały ekran wklej mój cały ostatni kod (przed chwilą go poprawiłem).
    Przejdź do arkusza excela.
    Menu widok - paski narzędzi - formularze.
    Naciśnij na tym menu przycisk i narysuj go w miejscu gdzie ma być.
    Pojawi się okno przypisania makra wskaż "kolory" daj OK i już.

    Z tym że mój kod jest pod ustawienia mojej tabeli. W twoim przypadku zapewne trzeba zmienić adresy i numery więc warto by było jednak dodać załącznik.

    Jeżeli chcesz poznać działanie tego makra można wytłumaczyć krok po kroku działanie każdej linii kodu.
  • Poziom 9  
    Dodam cały plik z tabelą, bo to faktycznie najlepsze rozwiązanie...
    Ogólnie to lubię dochodzić sam do takich rzeczy jednak mam straswznie dużo na głowie i nie mam totalnie czasu żeby próbować to rozgryźć...
    Musiałem jednak zapisać jako dokument excela z 2003 bo z excela 2007 rozszerzenie jest nieakceptowane przez elektrodę. Mam nadzieję ze przez to nie będzie problemu... dodałem jeszcze ewentualnie w PDFie
    Spróbuję jednak postąpić wg instrukcji marek003 :)
    pozdro
  • Pomocny post
    Poziom 40  
    W załączniku twój przykład.
    Rzeczywiście przy umieszczeniu kodu w module trzeba było troszkę jeszcze poprawić kod (co uczyniłem powyżej). [Ukierunkować na odpowiedni arkusz]

    Co do tabel:
    Proponuje najpierw wcisnąć przelicz a potem opisywać kolory. Chyba że kolory będą zawsze przypisane temu samemu odbiorcy.
    Wtedy przydałby się arkusz ze słownikiem.

    Kolejna rzecz to to że formuła obliczeniowa zajmuje przestrzeń w arkuszu od AE5 do AF60. W tych komórkach nie możesz nic wpisywać bo zostanie to wykasowane. Nie możesz też tych komórek scalać bo nastąpi błąd formuły.

    I ostatnia rzecz twoje tabele powinny być identyczne w każdym miesiącu (bez przesunięć wierszy lub kolumn).
  • Pomocny post
    Moderator Programowanie
    Pokazywanie tylko użytych kolorów nasunęło mi pewien pomysł...
    W załączniku (jeszcze) inna wersja rozwiązania, oparta na zwykłym wyszukiwaniu komórek o zgodnym kolorze.

    Edit: Sprawdziłem (Timerem) szybkość działania. Przegrywam z rozwiązaniem kolegi marek003 w stosunku 0,25 do 0,87 sek. :)
  • Pomocny post
    Poziom 40  
    :arrow: adamas_nt
    Jak analizuje twoje kody to widzę że bardzo daleko mi jeszcze do pisania makr.
    Dzięki twojej wiedzy można było skrócić czas obliczeń (przynajmniej za pierwszym razem o parę sekund :) a nie milisekund,a drugie rozwiązanie też jest ciekawe)
    [Do Autora: Koledze Adamas_nt'owi należy się wielokrotne pomógł- a może nawet więcej]

    Ja już tylko skromnie dołożyłem jeszcze arkusz ze słownikiem i jeden wiersz do kodu kolegi adamas_nt by makro wpisywało również nazwy firm.
    Code:
      Cells(i, "AG") = Sheets("Słownik").Cells(kom.Interior.ColorIndex + 1, 2).Value
    (Na marginesie kolejność kolorów w słowniku ma wielkie znaczenie i nie należy jej zmieniać najwyżej nie wypełniać nazwy firmy przy danym kolorze. Związane jest to z tym że makro w arkuszu Słownik nie szuka po kolorze. Kolory ułożone są po kolei wg indeksów. Nie wiedziałem jak bez przełączania się między arkuszami, co zaciemniło by główny kod, wykorzystać funkcję find dla koloru w arkuszu Słownik)
  • Pomocny post
    Poziom 40  
    Poniżej załączam ostateczną wersję
    ładnie poprawioną (w sobotni poranek :) ) przez kolegę adamas_nt
    Przedstawia czytelnie poszczególne kolory i firmy.
    Tak jak chciał to przedstawiać autor (załącznik autora z plikiem).

    Przedstawiam przesłany do mnie kod makra a poniżej plik z tym makrem.
    Code:
    Sub Kolory()
    

    Dim kom As Range, i As Integer, x As Integer
    Application.ScreenUpdating = False

    Range("AE5:AE230").Clear
    Range("AF5:AG230").ClearContents

    For i = 1 To 56
        Cells(i + 4, 34).Interior.ColorIndex = i
    Next i
     
    For Each kom In Range("C5:Z97")
        If kom.Interior.ColorIndex > 0 Then
            Cells(kom.Interior.ColorIndex + 4, 34) = Cells(kom.Interior.ColorIndex + 4, 34) + 0.5
        End If
    Next

    Cells(4, 31) = "Kolor"
    Cells(4, 32) = "Ilość godzin"
    Cells(4, 33) = "Firma"

    For i = 1 To 56
        If Cells(i + 4, 34).Value <> "" Then
            x = x + 4
           Cells(x + 4, 31).Interior.ColorIndex = Cells(i + 4, 34).Interior.ColorIndex
           Cells(x + 5, 31).Interior.ColorIndex = Cells(i + 4, 34).Interior.ColorIndex
           Cells(x + 4, 32).Value = Cells(i + 4, 34).Value
           Cells(x + 4, 33).Value = Sheets("Słownik").Cells(Cells(x + 4, 31).Interior.ColorIndex + 1, 2).Value
        End If
    Next i

    Range("AH5:AH60").Clear

    Application.ScreenUpdating = True

    End Sub
  • Poziom 9  
    Panowie jesteście niesamowici... Wiedziałem że Excel jest bardzo rozbudowanym programem ale wasze makra i propozycje przeszły moje oczekiwania... Jak tylko złapię chwilkę biorę sie za testy:)
    Gorąco pozdrawiam i punkty przyznaję rękami i nogami:) Dam znać jak mi to będzie działać... pozdrawiam gorąco!
  • Poziom 9  
    Wszystko działa pięknie - bardzo dzięuję za pomoc.. mam nadzieję że nie tylko mnie się te instrukcję przydadzą...
    Szacuneczek :)