Makra - zastawienie podajace ilość oraz sumę wydatków dla danego dnia tygodnia.

Witam.

Mam następujące zadanie do rozwiązania:

Za pomocą makra wykonać zestawienie, które podaje dla każdego dnia tygodnia liczbę wydatków i łączną kwotę funkcji:

Dzień tygodnia został oznaczone zakresem jako "data"
Kwota została zaznaczona jako "kwota":
Zakresy: dni, zlicz, suma, odpowiadają dzień tygodnia, ilość wystąpień, suma.

Makra napisałem, ale mam problem z sumowaniem. Proszę o pomoc.

Sub zliczani()
Dim dzien As Range, kwota As Range, dni As Range, dopisz As Boolean, i As Integer, j As Integer, n As Integer, zlicz As Range, suma As Range
Set dzien = Range("data")
Set kwota = Range("kwota")
Set dni = Range("L1:L66")
Set zlicz = Range("M1:M66")
Set suma = Range("n1:n66")

zlicz = 0
[l1] = "data"
[m1] = "ilość"
[n1] = "kwota"

'wyznaczenie pojedynczych dni

n = 2
For i = 2 To dzien.Count
dopisz = True
For j = 2 To n
If dzien(i) = dni(j) Then dopisz = False: Exit For
Next j
If dopisz Then
dni(n) = dzien(i)
n = n + 1
End If
Next i


'zliczanie na podstawie daty
For n = 2 To dni.Count
For i = 2 To dzien.Count
If dzien(i) = dni(n) Then zlicz(n) = zlicz(n) + 1
Next i
Next n


'sumowanie na podstawie daty


For n = 2 To dni.Count
For i = 2 To dzien.Count
If dzien(i) = dni(n) Then suma(n) = suma(n) + kwota(i)
Next i
Next n

End Sub
Edit:
Znalazłem problem, który mnie dręczył, ale pojawił się nowy.
Moje makro przy każdym uruchomieniu sumuje wartości z wcześniejszego uruchomienia.
Jak poradzić sobie z takim problemem?

A nie uczą was teraz, że warto dbać o pamięć komputera (Pomimo że wydaje się mieć on nieograniczone zasoby) i po zakończeniu obliczeń z wykorzystaniem funkcji "SET" warto po zakończeniu procedur wyzerować/wyczyścić zmienne.
Set dzien = Nothing
Set kwota = Nothing
Set dni = Nothing
Set zlicz = Nothing
Set suma = Nothing

Może to wystarczy.
Poza tym zobacz czy czasem po wykonaniu procedury nie zostaje coś zapisane w nazwanych zakresach i komórkach które na samym początku procedury są wpisywane do zmiennych (set)
Bo może trzeba też wyzerować zakresy.
Najlepiej jak byś załączył plik (jak to excel 2007 i wyżej to spakuj zipem).


A możesz dla mojej prywatnej wiedzy oświecić mnie, bo jestem samoukiem, i nie wiem, co robi/ma robić ten zapis:
[l1] = "data"
[m1] = "ilość"
[n1] = "kwota"

Wg mnie zdefiniowanie w wyznaczonej komórce danej wartości, która jest podana w cudzysłowach.

Ok.
Nie stosowałem nigdy zapisu [m1]
Zawsze robiem to przezn Range("m1")

A wyczyszczenie zmiennych pomogło na Twój problem?

W wyczyszczeniem zmiennych nie próbowałem, gdyż zauważyłem że nie miałem za każdym razem zerowania sumy, więc dodawało za każdym razem od nowa - mała nieuwaga, a tyle problemu.

Mam pytanie jeszcze dotyczące tworzenia tabel, gdyż ja definiuje z góry 66 pozycji, a teraz chcę, aby była wielkości wszystkich bez powtórzeń tj 24. Wiem, że muszę wykorzystać Redim, ale coś źle napisałem, mógłbyś zobaczyć?

Sub zliczanie2()

Dim dzien As Range, kwota As Range, dni() As String, dopisz As Boolean, i As Integer, j As Integer, n As Integer
Set dzien = Range("data")
Set kwota = Range("kwota")

[l1] = "data"


'wyznaczenie pojedynczych dni, długosc tebeli powinna odpowiadać "n"
ReDim dni(1 To n)
n = 2
For i = 2 To dzien.Count
dopisz = True
For j = 2 To n
If dzien(i) = dni(j) Then dopisz = False: Exit For
Next j
If dopisz Then
dni(n) = dzien(i)
n = n + 1
End If
Next i

End Sub

Przy ReDim dni(1 To n) musisz wcześniej określić to "n". Tak ci nie przepuści.

Tak na marginesie:
Był już na forum łatwiejszy sposób usuwania duplikatów. Jak dobrze pamiętam - z wykorzystaniem błędu. Gdzie indeks tabeli był tym samym co dana w tabeli pod tym indeksem.

edit
-----------------------
Znalazłem usuwanie duplikatów w jednym przebiegu pętli
Link tutaj

Dziękuje bardzo, przeanalizuję.

Uważam że w Twoim przypadku kod który pomija duplikaty wyglądał by następująco:



edit
---------------------------
Poprawiłem kod bo zapomniałem o ReDim (pisałem z "głowy") dodam dla informacji że Preserve pozostawia dane w tabeli redefiniowanej.

Acha pamiętaj też że po wyjściu z powyższej pętli wartość n jest większa o jeden od maksimum w tabeli dni()

By było takie samo n trzeba zmienić kolejność w warunku (wcześniej ustawiając n=1)

n = n + 1
ReDim Preserve dni(n)
dni(n) = dzien(i)

Dziękuje bardzo. Ale mam pytanie dotyczące miejsca wyświetlania mojej tabelki wyjściowej. W pliku który pobrałem z linka który mi podałeś, wyświetlanie było w oddzielnym userform - jak zdefiniować teraz zakres nowej tabeli, powiedzmy w tym samym arkuszu?

Nie wiem czy do końca cię rozumiem.

Przeanalizuj kod który stworzyłem specjalnie dla Ciebie w poprzednim topiku (on jest na podstawie wcześniejszego linka).
Zauważ że zakres tabeli tworzy (powiększa) się z każdą chwilą kiedy pojawi się kolejny "nie dubel" (redim).

Po zakończeniu pętli masz n większe o jeden od danych w Twojej tabelce dni()
Więc mając ten parametr możesz spokojnie zdefiniować zakres. (patrz kod pod przyciskiem 1)

Lecz jeżeli wykorzystujesz tabele dni() tylko do tego by ją "przepisać" do komórek arkusza to w ogóle ją pomiń (nie będzie wtedy potrzeby nic redefiniować).
Patrz kod pod drugim przyciskiem, czyli:


Czy może chcesz zdefiniować nowy nazwany zakres za pomocą makra? Nie do końca rozumiem twoje pytanie.

Znalazłem błąd i zrozumiałem w 90% makro, które mi napisałeś. Dzięki wielkie.

Jeżeli chcesz bym Ci coś wyjaśnił z "mojego" kodu to pytaj. Spróbuję wytłumaczyć.

Wg mnie cała procedura działa tak:

Tworzę nową kolekcję do której dodaje elementy z tabeli "dzień" i porównuje z kluczem, który jest tą sama tabelką.
I teraz mamy err.number=/<>0. Tu mam problem, aby zdefiniować ten błąd, ale ten zapis sprawdza, czy dana wartość wystąpiła już wcześniej - dla równej 0 wartość wcześniej nie wystąpiła, dla <> 0 wartość wystąpiła. I dalej przechodzimy do następnego kroku.
Edit:
Już wiem jak to działa, znalazłem ciekawy opis tej metody.

" Aby do kolekcji dodać nowe elementy, należy użyć polecenia o następującej składni:

obiekt.add pozycja, klucz, przed, po

Jeżeli zostanie użyty argument "klucz", jego wartość musi być unikatowym łańcuch tekstowym pełniącym funkcje niezależnego klucza stosowanego przy uzyskiwaniu dostępu do elementu zbioru. Istotne jest tutaj słowo unikatowe. Przy próbie umieszczenia w zbiorze klucza, który nie jest unikatowy, pojawia się błąd i pozycja nie zostanie dodana. Zdarzenie to może zostać wykorzystane do utworzenia kolekcji składającej się wyłącznie z unikatowych elementów"

Ponadto mam jeszcze dwa pytania związane właśnie z tym zadaniem:

1) jak zdefiniować nowy zakres dla kolumna "dni" skoro jest on ruchomy?
Chodzi mi o to, że po wygenerowaniu wartości unikatowych (powiedzmy w kolumnie L), chcę dla nich policzyć ilość wystąpień w oryginalnej kolumnie "dzień".
2) jak wyznaczyć 3 maksymalne wartości?

Dodano po 33 [minuty]:

znalazłem odpowiedź na pytanie 1 :

Sub zliczanie2()
Dim dzien As Range, dni() As String, i As Integer, n As Integer, zlicz As Range


Dim unikalne As New Collection
Set dzien = Range("data")


ActiveSheet.Range("L1:N60").ClearContents


Range("L:L").ClearContents
Range("m:m").ClearContents
Range("n:n").ClearContents
[L1] = "wynik"

n = 1
On Error Resume Next
For i = 2 To dzien.Count
unikalne.Add CStr(dzien(i)), CStr(dzien(i))
If Err.Number = 0 Then
n = n + 1
ReDim Preserve dni(n)
dni(n) = dzien(i)
End If
Err.Clear
Next i

For i = 2 To n
Cells(i, 12) = dni(i)
Next i

'zliczanie na podstawie daty

Set zlicz = Range(Cells(1, 13), Cells(UBound(dni), 13))
zlicz = 0

For n = 2 To UBound(dni)
For i = 2 To dzien.Count
If dzien(i) = dni(n) Then zlicz(n) = zlicz(n) + 1
Cells(n, 13).Value = zlicz(n)
Next i
Next n

End Sub

A możesz korzystać z funkcji arkuszowych excela? Czy wszystko ma być "czystym" basicem?

Max.k() to w VBA Application.WorksheetFunction.Large(ZAKRES, pozycja)


czyli u ciebie
maksimum1= Application.WorksheetFunction.Large(Range(Cells(1, 12), Cells(UBound(dni), 12)) , 1)
maksimum2= Application.WorksheetFunction.Large(Range(Cells(1, 12), Cells(UBound(dni), 12)) , 2)
maksimum3= Application.WorksheetFunction.Large(Range(Cells(1, 12), Cells(UBound(dni), 12)) , 3)

Można też posortować kolumnę z danymi malejąco i wybrać pierwsze 3 komórki.

Lub ostatecznie trzy pętle po sobie. pierwsza pętla porównuje pierwsza daną z drugą i zapisuje do zmiennej wyższą wartość i jej adres. Tą wartość porównuje następnie z trzecią i większą zapisuje wraz z jej adresem itd. do końca danych w kolumnie. Druga pętla robi to samo tylko z ominięciem wcześniej wybranego adresu a trzecia to samo z ominięciem dwóch poprzednich adresów.



Prawdę mówiąc do zadania pierwszego tez można było zastosować licz.jeżeli()
czyli w VBA Application.WorksheetFunction.CountIf(zakres,kryterium)
Była by tylko jedna pętla.

czy uogólniona wersja będzie wyglądać następująco:

maksimum (i)= Application.WorksheetFunction.Large(Range(Cells(1, 12), Cells(UBound(dni), 12)) , i)

gdzie i będzie < UBound(dni)

jeżeli i=UBound(dni) dostajemy procedurę sortowania

Nie. (choć też i tak)
Widzę że tabele zaciemniły twój obraz. Masz znaleźć trzy maksymalne dane więc po co sortować wszystkie dane.
maksimum1 to pojedyncza zmienna do której zostanie przypisane największe maksimum w zakresie Range(Cells(1, 12), Cells(UBound(dni), 12))
maksimum2 to druga zmienna a maksimum3 trzecia.

Ten kod (napisany przeze mnie) jest gotowy. Wklej go w swoją procedurę lub zamiast maksimum1 wpisz np. [o1] czyli
[o1]= Application.WorksheetFunction.Large(Range(Cells(1, 12), Cells(UBound(dni), 12)) , 1)
[o2]= Application.WorksheetFunction.Large(Range(Cells(1, 12), Cells(UBound(dni), 12)) , 2)
[o3]= Application.WorksheetFunction.Large(Range(Cells(1, 12), Cells(UBound(dni), 12)) , 3)
wtedy maksymalne wartości od razu pojawią się w trzech pierwszych komórkach kolumny O

edit
----------------------------
Choć masz też rację że jeżeli ze zmiennej maksimum zrobić tabelę wtedy w tabelce maksimum(i) dane będą posortowane malejąco. Tylko że ty miałeś znaleźć tylko 3 pierwsze maksyma

Ja wiem, spytałem o trzy wartości, aby zobaczyć ogólny algorytm, że tak powiem. Gdyż te zadania są stopniowe. Chciałbym też sam popracować, aby pewne rozwiązania znaleźć, a nie tak na gotowe.

Teraz pracuje nad dodatkową opcją - chcę pobrać wartość tzn:


wartosc_max = InputBox("podaj ilość maksymalnych wartości: ")

następnie sprawdzam tą wartość z UBound(dni) tzn:

If wartosc_max > UBound(dni) - 1 Then ans = ans & "wartość ilości waksymalnych jaka podałeś jest większa niż 24 " & vbYesNo + vbQuestion & "czy chcesz kontynyować"
If ans = vbNo Then Exit Sub

MsgBox ans


Teraz tu jest problem, bo coś nie działa, w sumie jakby działało, to bym nie pisnął, że jest problem.
Jak temu zaradzić, co robię źle?

Błąd polega na tym ze nie tu wywołujesz okno msgbox i w dodatku trochę inaczej się je parametryzuje a zmienna ans powinna przenosić tylko wybor 9jaki klawisz wcisnąłeś

wartosc_max = InputBox("podaj ilość maksymalnych wartości: ")

If wartosc_max > UBound(dni) - 1 Then ans = Msgbox( "wartość ilości waksymalnych jaka podałeś jest większa niż 24 " , vbYesNo + vbQuestion , "czy chcesz kontynyować")
If ans = vbNo Then Exit Sub

Ale ja bym już w pytaniu nakazał wybrać mniejsza cyfrę 9oczywiście jeszzcepoźniej bym ja sprawdził np.

wartosc_max = InputBox("podaj ilość maksymalnych wartości nie wiekszej niż " & UBound(dni) -1 & " : ")
If wartosc_max > UBound(dni) - 1 Then
Msgbox "wartość ilości waksymalnych jaka podałeś jest większa niż " & UBound(dni) - 1" & " Popraw się.", vbCritical , "Błąd"
Exit Sub
end if

marek003 Witam "starego" znajomego

Nie czytałem dokładnie od początku, ale mam drobną uwagę do postu wyżej.
Co będzie, jeśli User wpisze:
1. tekst
2. liczbę z przecinkiem/kropką (a co, wolno mu)
3. liczbę ujemną
4. Inne nieprzewidziane rzeczy Np przez ctr+v

Zwykle zamykam w takich przypadkach InputBox w pętli 'Do' i trzymam Usera do skutku. Można dodatkowo zaświecić mu w oczy MsgBox'em, jeśli przesadzi
Np coś w ten deseń

adamas_nt A witam, witam i o zdrowie pytam
Pomyślałem, o tym ale na chwile obecną nie sugerowałem, bo stwierdziłem że kolega-autor, się uczy od podstaw, więc na razie nie wybiegłem poza "schemat". Jednak rzeczywiście należałoby o tym wspomnieć.

Jeszcze raz pozdrawiam szanownego "starego" kolegę

Witam.

Dziękuje za informacje które są pomocne i powoli zaczynam ich używać. Jednakże postanowiłem troszeczkę pokombinować i pododawać troszkę rzeczy ale nie wszystko mi wychodzi.

W załączniku załączam plik na którym pracuje.
Stworzyłem łącznie 4 procedury podpięte pod odpowiednie przycisk,i, ale są problemy których na chwile obecna nie potrafię rozwiązać.

Procedura 1)

Usuwa duplikaty po dacie, następnie wyliczam ilość wystąpień i sumę. To działa.
Ale została dodana funkcja która wypisuje oddzielnie ilość max'ów np. wartość_max=3, zostaną wypisane 3 największe wartości i tu pojawia się problem, gdyż wykorzystałem makro podane powyżej ale ono nie działa jakby poprawnie, w moim przypadku bo pewnie coś źle napisałem.
I tutaj chciałem się spytać dlaczego definiujemy na początku "wartosc_max = 10"?
Procedura 2)
Podobna jak procedura 1, ale bez parametru max, działa poprawnie.

Procedura 3 -sorotwanie2_suma

Sortowanie dla sumy. Problem z mojej strony polega na nieumiejętności zdefiniowania zmiennej wielkości tablicy oraz rozszerzeniu na kolumnę L i M.

Procedura 4- kolorowanie2

Zaznaczenie na kolor n- największych wartości. W tym przypadku nie rozpatruje na chwilę obecnej dodatkowych założeń, zrobię to sam bazują na wcześniejszych informacjach
Dzięki za pomoc

Procedura pierwsza
Co ci źle działa? maks czy procedura sprawdzająca?
Wg mnie maks działa bez zarzutu.

Natomiast co do procedury sprawdzającej:
Kolega adamas_nt dał Ci przykład, który w twoim przypadku nie do końca się sprawdzi niemniej pokazuje zasadę sprawdzania danych które podał użytkownik.

Przyznam że sam to analizuje i trochę się dziwie niemniej jest to wytłumaczalne.

Kłopot/niekłopot polega na tym że akurat Ty definiujesz wcześniej zmienne (co jak dla mnie jest bardzo pozytywnym zachowaniem przy programowaniu) a to trochę rozwala pomysł kolegi adamasa.
Co prawda w przykładzie poprzez sztywne przypisanie wartości do tej zmiennej (bez jej wcześniejszej deklaracji) również następuje jej "przypisanie" do integer.

A w związku z tym jeżeli wpiszesz tekst/ literę/ naciśniesz cancel czy wyłączysz okno inputbox'a wartość zmiennej "wartosc_max" nie zostanie zmieniona jako niespełniająca właściwości integer. W związku z tym "wartosc_max" będzie zawsze równe 44 (wcześniejsza sztywna deklaracja).
A jeżeli tak pętla powtarza obrót.
Z kolei jeżeli wpiszesz 0 to załapie się pod "Empty" i wyłączy procedurę.

Więc zabezpieczenie właściwie działa bo możesz podać jedynie dobrą liczbę inaczej nie puści. Co prawda nie ma efektów poprawiania użytkownika ale ...

Tak jak pisałem wg mnie to jest przykład który dostosuj do siebie.
Na początku zamiast 44 wpisz UBound(dni)+1
Choć ja przeorganizował bym tą pętlę całkowicie.


Problem drugi
Przecież ilość wierszy / danych określiłeś przez tabelę dni(). (w niej jest tyle danych ile jset maksymalnie bez powtórzeń)
Jej wielkość plus nagłówek określa tą ilość w arkuszu (już ci o tym pisałem) więc czego nie umiesz/rozumiesz.

Innym wyjściem dla ciebie (kiedy procedura nie wylicza wcześniej tabeli dni()) można określić ostatni wiersz kolumny L poprzez funkcję:
OstatniWiersz = Cells(ActiveSheet.Rows.Count, "L").End(xlUp).Row


W procedurze czwartej przekombinowałeś z iteracją pętli (jedną niepotrzebnie uzależniłeś od drugiej.


EDIT
----------------------
Ja np. procedurę sprawdzającą dane napisał bym tak:
warunek (to co jest u Ciebie) wcześniejsza deklaracja zmiennej
Dim wartosc_max As integer

wtedy też nie trzeba będzie definiować żadnej wstępnej wartości dla zmiennej wartosc_max (na 10 czy 44) tylko od razu:

Ad Problem 1
No tak. Żeby pętla sprawdzająca mogła działać, nie może być wyłączona obsługa błędów, zmienna musi być zadeklarowana jako Variant i konwertowana do Int tylko i wyłącznie po wprowadzeniu prawidłowej wartości.

Podsumowując: Chodzi o to, żeby nieprawidłowa wartość z InputBox'a, nie zatrzymywała działania makra. Proszę wypróbować, wpisując tekst, z 'On Error Goto 0' przed pętlą z Inputbox'em.

marek003 napisał:

Przyznam że sam to analizuje i trochę się dziwie

No właśnie dla mnie nie do końca to prawidłowo działało i szukałem przyczyn braku błędu, a właściwie tego, że zmienna nie zmienia się pomimo specjalnie wprowadzanych błędnych danych - myślałem że to tylko wcześniejsza deklaracja załatwia chociaż miałem obiekcje, że jak już tak działa to może coś zmienili w E2010.

Zapomniałem, że przecież jest wyłączenie obsługi błędów w kodzie wyżej co tłumaczy teraz wszystko i moje wcześniejsze wyjaśnienia nie są jednak prawidłowe choć dobrze opisują poszczególne przypadki wprowadzanych danych.

marek003 napisał:

moje wcześniejsze wyjaśnienia (...)

Nikt tego nie neguje
We wszystkich opisanych przypadkach, niepoprawna wartość "nie przechodzi" i o to przecież chodzi. Jednak oberwanie po oczach oknem debugera jest dla Usera bardziej stresujące niż "zawrotka" do InputBox'a. Przynajmniej dla mojego etatowego testera w osobie żony
Przewidywana reakcja w pierwszym przypadku: "Adam, coś skopałeś!"
W drugim: "Co robię źle?"
Widzisz różnicę?

Dziękuję za pozdrowienia i wzajemnie...

Dzięki za info, posiedzę sobie pewnie troszkę i pomyślę w samotności