Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Makro VBA zliczające procenty

darko2000 · Starszy Forumowicz Wersja: Win Office 2019 Posty: 44

Witam,
Potrzebuje makro, które by robiło coś takiego
1. W kolumnie AK wyfiltrowało wartość 1
2. W kolumnie AM sprawdziło by, które rekordy po zsumowaniu dadzą 90%
3. Jeżeli jakiś rekord wejdzie do 90% to w kolumnie AN niech przy tym rekordzie będzie 1
4. Jeżeli jakiś rekord nie będzie łapał się do 90% to zostaje puste
5. W kolumnie AK wyfiltrowało wartość 2 i powtórzyć wszystkie kroki
6. Sprawdzenie zrobić tylko dla wartości od 1 do 6 w kolumnie AK

i jeszcze jeden temat:
7. jeżeli w kolumnie AN będą już 1 to niech poflirtuje kolumnę AM od największej wartości
8. w kolumnie AO zacznie numerować 1, 2, 3 4..... ale tylko tam gdzie są 1
9. dla reszty produktów u danego dostawcy niech wstawi 1000

zamieszczam plik jak by to miało wyglądać

procenty.xlsm

Pobierz Plik ściągnięto 15 raz(y) 172.01 KB

procenty2.xlsm

Pobierz Plik ściągnięto 14 raz(y) 173.76 KB

Kaper · Wysłany: 02-06-2022, 15:17

np.:

Kod:

Sub test()
Dim lr As Long, i As Long, licznik As Long, suma As Double, kom As Range
lr = Cells(Rows.Count, "AK").End(xlUp).Row
For i = 1 To 6
Range("A1:AV" & lr).AutoFilter Field:=37, Criteria1:=i
suma = 0
licznik = 0
For Each kom In Range("AM2:AM" & lr).SpecialCells(xlCellTypeVisible)
If suma <= 0.9 Then
suma = suma + kom.Value
licznik = licznik + 1
kom.Offset(0, 1) = 1
kom.Offset(0, 2) = licznik
Else
kom.Offset(0, 2) = 1000
End If
Next kom
Next i
ActiveSheet.AutoFilterMode = False
End Sub

procenty.xlsm

Pobierz Plik ściągnięto 20 raz(y) 176.93 KB

darko2000 · Starszy Forumowicz Wersja: Win Office 2019 Posty: 44

niestety, dobrze jest tylko na dostawcy nr 1, na następnych dostawcach źle przypisuje, załączam przykład na dostawcy 6, powinno być po kole w wierszach 1,1 później 1,2 później 1,3 i tak dalej wiersze, które się nie załapały u dostawcy 6 do 90% powinny być w kolumnach pusty i 1000, tak jakby brakowało filtrowania i sortowania po danym dostawcy

procenty.xlsm

Pobierz Plik ściągnięto 13 raz(y) 186.97 KB

Tajan · **Pomógł:** 5155 razy Posty: 11264

Jesteś pewien, że uruchomiłeś właściwe makro? U mnie wszystko działa prawidłowo. Zobacz na obrazie.
Dla pewności poprawnych ustawień, przed:

Kod:

lr = Cells(Rows.Count, "AK").End(xlUp).Row

wstaw linię:

Kod:

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

bo być może przed uruchomieniem makra arkusz był w stanie filtrowania.

procenty.png

Plik ściągnięto 2 raz(y) 43.69 KB

darko2000 · Starszy Forumowicz Wersja: Win Office 2019 Posty: 44

faktycznie teraz działa, mam jeszcze jedno pytanie jak przenieść ten kod żeby działał na inne kolumny, czyli teraz filtruje dostawcę po "AK" procenty były w "AM" wyniki w "AN" i w "AO" a teraz chciałbym żeby dodatkowo zrobił dokładnie to samo tylko dalej w prawo czyli za każdym razem filtruje sześciu dostawców po "AK" i
procenty ma w "AQ" wyniki w "AR" i "AS"
procenty ma w "AY" wyniki w "AZ" i "BA"
procenty ma w "BC" wyniki w "BD" i "BE"
procenty ma w "BK" wyniki w "BL" i "BM"
procenty ma w "BO" wyniki w "BP" i "BQ"
procenty ma w "BW" wyniki w "BX" i "BY"
procenty ma w "CA" wyniki w "CB" i "CC"
czyli operacja będzie 8 razy działała, dodałem przykładowy plik

procenty (2).xlsm

Pobierz Plik ściągnięto 13 raz(y) 474.34 KB

Tajan · **Pomógł:** 5155 razy Posty: 11264

Przykładowe makro:

Kod:

Sub test()
Dim lr As Long, i As Long, licznik As Long, suma As Double, kom As Range
Dim kolumny, kol

kolumny = Array("AQ", "AY", "BC", "BK", "BO", "BW", "CA")

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

lr = Cells(Rows.Count, "AK").End(xlUp).Row

For i = 1 To 6

Range("A1:AV" & lr).AutoFilter Field:=37, Criteria1:=i

For Each kol In kolumny

suma = 0
licznik = 0

For Each kom In Range(kol & "2:" & kol & lr).SpecialCells(xlVisible)

If suma < 0.9 Then
suma = suma + kom.Value
licznik = licznik + 1
kom.Offset(0, 1) = 1
kom.Offset(0, 2) = licznik
Else
kom.Offset(0, 1) = Empty
kom.Offset(0, 2) = 1000
End If

Next kom

Next kol

Next i

ActiveSheet.AutoFilterMode = False

End Sub

Zwracam jednak uwagę, że dla pewnych układów danych to makro nie będzie działało prawidłowo.
Zwróć np. uwagę na wyniki działania dla kolumny BW lub CA dla wartości 6. Wydaje mi się, że nie będzie to poprawne.

darko2000 · Starszy Forumowicz Wersja: Win Office 2019 Posty: 44

no faktycznie źle działa, myślałem żeby użyć 8 razy tego pierwszego makra i tylko podmieniać dane czy wystarczy zamienić tą linijkę

Kod:

For Each kom In Range("AM2:AM" & lr).SpecialCells(xlCellTypeVisible)

na np:

Kod:

For Each kom In Range("AQ2:AQ" & lr).SpecialCells(xlCellTypeVisible)

a może makro się do tego nie nadaje i lepiej wpisać formuły w tych dwóch kolumnach wynikowych? może wie Pan jak powinny być napisane?

Tajan · **Pomógł:** 5155 razy Posty: 11264

To makro działa w sposób jak opisałeś (mniej, więcej) i to jest OK. Pisząc o nieprawidłowościach miałem na myśli sytuację, że dla danych suma wyliczona wynosi 100 a nie 90%. Po prostu, ostatnia wartość jest na tyle duża, że pomimo iż suma cząstkowa nie osiąga 90%, to jej dodanie powoduje osiągnięcie wartości 100%. Tutaj powinno się zadecydować co z takimi przypadkami, czyli przy jakich wartościach granicznych przerwać sumowanie. Inaczej mówiąc należałoby określić z jaką tolerancją ta suma powinna być wyliczona.

darko2000 · Starszy Forumowicz Wersja: Win Office 2019 Posty: 44

dziękuję za próbę pomocy, u mnie to makro źle działa coś mi się wydaje że nie potrafi
prawidłowo przefiltrować tych danych i dla tego błędnie przypisuje wartości (powinien dla każdego dostawcy oddzielnie filtrować te 8 kolumn z procentami kolumna po kolumnie i dopiero wyliczać 90 %) dodałem plik z wynikami, no mam jeszcze znajomego który może wymyśli formuły na sztywno bo makro raczej tego problemu nie przeskoczy :-(

makro.jpg

Plik ściągnięto 4 raz(y) 229.99 KB

darko2000 · Starszy Forumowicz Wersja: Win Office 2019 Posty: 44

tak dla ćwiczenia zamieszczam mój plik można zobaczyć dokładnie gdzie makro nie daje rady, może ktoś będzie miał w przyszłości podobny temat i będzie łatwiej znaleźć jakieś rozwiązanie :-)

test.xlsx.xlsm

Pobierz Plik ściągnięto 14 raz(y) 526.36 KB

Tajan · **Pomógł:** 5155 razy Posty: 11264

Sorry, w linii:

Kod:

kolumny = Array("AQ", "AY", "BC", "BK", "BO", "BW", "CA")

brakuje kolumny AM. Powinno być:

Kod:

kolumny = Array("AM", "AQ", "AY", "BC", "BK", "BO", "BW", "CA")

darko2000 · Starszy Forumowicz Wersja: Win Office 2019 Posty: 44

tą zmianę sam już sobie wprowadziłem, no ale to nie ma wpływu na to, że makro działa niepoprawnie co można zobaczyć w pliku test.xlsx.xlsm który zamieściłem wcześniej

Tajan · **Pomógł:** 5155 razy Posty: 11264

A czy mógłbyś napisać konkretnie, co jest źle?

darko2000 · Starszy Forumowicz Wersja: Win Office 2019 Posty: 44

już dwa razy opisałem dla czego to makro źle działa, wystarczy, że otworzy Pan plik test.xlsx.xlsm został on przepuszczony przez to makro i już na pierwszym dostawcy widać co jest źle, przefiltrowane są wartości procentowe po kolumnie AY od największej do najmniejszej w kolumnie AZ powinny być wartość 1 (tam gdzie suma procentów z AY da 90%) do tego w kolumnie BA powinny iść wartości 1,2,3,4,5,6,7..... a mamy 1000, 5, 101, 102, 1, 2 itd. jeżeli nie chce Pan otwierać tego pliku to przesyłam PrtScr oczywiście błąd jest na wszystkich dostawcach na wszystkich polach z danymi, tak jak już pisałem wydaje mi się, że makro powinno osobno filtrować 8 razy każdą kolumnę z procentami i dopiero wyliczać dane dla 2 następnych kolumn, teraz wygląda to tak, że chyba cały czas filtruje po jednej kolumnie i dla tego błędnie przypisuje
wszystkie wartości

błąd.jpg

Plik ściągnięto 4 raz(y) 230.7 KB

Tajan · **Pomógł:** 5155 razy Posty: 11264

Naprawdę nie rozumiem w czym leży problem bo u mnie po uruchomieniu makra wyniki są zupełnie odmienne. Załączam obraz oraz plik.
Ciągle mam podejrzenie, ze uruchamiasz niewłaściwe makro bo przaktycznie od początku jest ten sam problem, u mnie działa, u ciebie - nie.

procenty.png

Plik ściągnięto 8 raz(y) 78.08 KB

test.xlsx (1).xlsm

Pobierz Plik ściągnięto 13 raz(y) 526.72 KB