Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 72901 Skopiuj do schowka Makro VBA zliczające procenty
Autor Wiadomość
darko2000 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 02-06-2022, 07:16   Makro VBA zliczające procenty

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

ID posta: 417664 Skopiuj do schowka
 
 
Kaper 



Zaproszone osoby: 2
Wersja: Win Office 365
Pomógł: 4374 razy
Posty: 8640
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

_________________
Kaper Jej Królewskiej Mości :boss

Jeśli dane będą torturowane dość długo, przyznają się do wszystkiego
ID posta: 417681 Skopiuj do schowka
 
 
darko2000 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 02-06-2022, 18:33   

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

ID posta: 417685 Skopiuj do schowka
 
 
Tajan


Pomógł: 5155 razy
Posty: 11264
Wysłany: 02-06-2022, 19:42   

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

ID posta: 417686 Skopiuj do schowka
 
 
darko2000 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 02-06-2022, 21:08   

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

ID posta: 417687 Skopiuj do schowka
 
 
Tajan


Pomógł: 5155 razy
Posty: 11264
Wysłany: 02-06-2022, 22:28   

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.
ID posta: 417688 Skopiuj do schowka
 
 
darko2000 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 03-06-2022, 07:01   

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?
ID posta: 417692 Skopiuj do schowka
 
 
Tajan


Pomógł: 5155 razy
Posty: 11264
Wysłany: 03-06-2022, 08:27   

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.
ID posta: 417693 Skopiuj do schowka
 
 
darko2000 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 03-06-2022, 09:51   

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

ID posta: 417702 Skopiuj do schowka
 
 
darko2000 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 03-06-2022, 10:10   

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

ID posta: 417709 Skopiuj do schowka
 
 
Tajan


Pomógł: 5155 razy
Posty: 11264
Wysłany: 03-06-2022, 10:36   

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")
ID posta: 417711 Skopiuj do schowka
 
 
darko2000 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 04-06-2022, 07:21   

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
ID posta: 417741 Skopiuj do schowka
 
 
Tajan


Pomógł: 5155 razy
Posty: 11264
Wysłany: 04-06-2022, 13:59   

A czy mógłbyś napisać konkretnie, co jest źle?
ID posta: 417752 Skopiuj do schowka
 
 
darko2000 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 04-06-2022, 16:03   

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

ID posta: 417756 Skopiuj do schowka
 
 
Tajan


Pomógł: 5155 razy
Posty: 11264
Wysłany: 04-06-2022, 17:51   

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

Ostatnio zmieniony przez Tajan 04-06-2022, 18:24, w całości zmieniany 1 raz  
ID posta: 417758 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.wip.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe