[excel] Zliczanie konkretnych wyrażeń


(oprych) #1

Witam

Poszukuje formuły która umożliwiałaby zliczanie punktów za poszczególne miejsce

excel01.jpg

Jak zrobić aby w komórce B2 zsumował liczby z B1 licząc 1 jako 5, 2 jako 3 a 3 jako jedynki - zgodnie z liczbami w kolumnie G?

Czyli w B2 powinno być 7, w C2= 3, D2=8


(Tomek Matz) #2

Nie jestem w 100% pewien, ale bez makra się chyba nie obejdzie. Czy w tym arkuszu możesz takowe zastosować? Wyglądałoby to tak, że na arkuszu umieściłbyś sobie przycisk, który wykonywałby odpowiednią procedurę.

EDIT: Tak wyglądałby kod tej procedury ... (zaraz wrzucę link do pliku)

Dim columnsCount As Integer

Dim rowNumber As Integer

Dim columnNumber As Integer


columnsCount = 3 ' Liczba kolumn, które mają zostać przeliczone (W przykładzie jest to 3)

rowNumber = 1 ' Numer wiersza, który zawiera kolumny, które mają zostać przeliczone (W przykładzie jst to 1)

columnNumber = 2 ' Numer kolumny, która jest pierwszą z tych, które mają zostać przeliczone (W przykładzie jest to B, czyli kolumna 2)


Dim i As Integer

Dim j As Integer

Dim v As Variant

Dim result As Integer


For i = columnNumber To columnsCount + 1

    v = Split(Cells(rowNumber, i), ",")

    result = 0

    For j = LBound(v) To UBound(v)

        If v(j) = 1 Then

            result = Range("G2").Value + result

        ElseIf v(j) = 2 Then

            result = Range("G3").Value + result

        ElseIf v(j) = 3 Then

            result = Range("G4").Value + result

        End If

    Next j

    Cells(rowNumber + 1, i) = result

Next i

(Welpa75) #3

Przykładowe makro wyliczające sumę dla jednej komórki "B1", a wynik w "B2". Oczywiście wartości punktowe przypisane ręcznie w kodzie, ale można przyporządkować im komórki. Makro dopasowane do twojego pliku, utwórz przycisk i przypisz makro.

Sub Makro1()

'

'Zmienne

    Dim komorka As String 'zawartość komórki "B1" w formie ciągu tekstowego

    Dim dane() As String 'deklaracja tablicy o zmiennym rozmiarze

    Dim rozmiar As Integer 'deklaracja zmiennej która przechowa rozmiar tablicy

    Dim wynik As Integer 'deklaracja zmiennej która przechowa sumę

    '

    Range("B1").Select

    komorka = ActiveCell.FormulaR1C1 'zmienna "komorka" przyjmuje tekst z komórki "B1"

    '

    dane = Split(komorka, ",") 'dzielenie tekstu z komórki "B1" na oddzielne wartości

    rozmiar = UBound(dane)

    '

    For i = 0 To UBound(dane) 'przeliczanie wartości z komórki "B1" na odpowiednie wartości punktowe

        Select Case CInt(dane(i))

            Case 1

                punkty = 5

            Case 2

                punkty = 3

            Case 3

                punkty = 1

        End Select

    wynik = wynik + punkty

    Next i

    '

    Range("B2").Select

    ActiveCell.FormulaR1C1 = wynik

    '

End Sub

(oprych) #4

Dziękuje Panowie.

W weekend na spokojnie przetestuje rozwiązanie. Obawiam się tylko, że makra mogą być zbyt sztywne, bo zazwyczaj jest koło 10 kategorii, ale z ilością klubów bywa różnie czasami 5, a czasami 30


(Pampali) #5

Jeżeli chcesz wykonać jakiekolwiek obliczenia to nigdy, przenigdy nie stosuj w excelu zapisu kilku wartości w jednej komórce. Aby dokonać obliczeń na zawartości komórki B2 trzeba najpierw jej zawartość rozdzielić na składniki - da się to zrobić stosują funkcję warunkową JEŻELI w połączeniu z funkcjami tekstowymi LEWY, PRAWY, FRAGMENT.TEKSTU, DŁ niestety nie ma możliwości zrobienia pętli więc wyjdzie z tego pokręcona, złożona i bardzo długa formuła. Ponadto zwróć uwagę że w zależności od ilości liczb w komórce B2 Excel będzie różnie traktował jej zawartość: jeżeli B2 będą dwie liczby rozdzielone przecinkiem to excel będzie je traktował jak jeden ułamek (1,3 - jeden i trzy dziesiąte), jeżeli będzie tam więcej liczb to excel potraktuje je jak tekst, lub datę.

Przemyśl strukturę swojego arkusza i zapytaj jeszcze raz.


(Tomek Matz) #6

Obiecany link do pliku http://rapidshare.com/files/427787418/Zeszyt1.xls

Pozdrawiam,

EDIT:

To nie powinno w niczym przeszkadzać. Wystarczy podmienić wartości odpowiednich zmiennych w kodzie procedury. Jak chcesz możesz dać bardziej złożony przykład to zobaczę co i jak.


(floyd) #7

Aby procedura była bardziej uniwersalna czyli na dowolną liczbę kategorii czy klubów pozwoliłem sobie trochę ją usprawnić.

Mam nadzieję, że nie będziesz miał nic przeciwko temu. :slight_smile:

Uwaga: Kolumnę G z punktacją należało by przenieść w inne miejsce (Przynajmniej o jedno oczko niżej).

Sub Przycisk1_Kliknięcie()

Dim i, j, result, rowNumber As Integer

Dim v As Variant

i = 1: rowNumber = 1

Do

i = i + 1

If Val(Trim(Cells(rowNumber, i))) = 0 Then Exit Do

    v = Split(Cells(rowNumber, i), ","): result = 0

    For j = LBound(v) To UBound(v)

    result = Range("G" + CStr(v(j) + 1)).Value + result

    Next j

    Cells(rowNumber + 1, i) = result

Loop

End Sub

(Tomek Matz) #8

Zmieniaj dowolnie, byle żeby było lepiej :stuck_out_tongue:

To oznacza zmianę kodu (zapis "+1") (Poza tym wydaje mi się, że przez kategorie chodzi o to, że może być kilka kolumn "G", a punktowane są tylko 3 miejsca w każdej kategorii).


(floyd) #9

Co tam mają oznaczać te kategorie to dokładnie wie tylko autor pytania. Jak na razie to przedstawił swój problem trochę chaotycznie.

Być może jest tak jak piszesz z tymi kategoriami i wszystko zależy gdzie te kategorie będą umieszczone, ale to już powtórzenie tych samych procedur, a z punktacją też może być różnie. Ostatecznie można punktować więcej miejsc.


(Tomek Matz) #10

Może tak być. Ostatecznie można przygotować jakąś funkcję i w obrębie procedury obsługującej przycisk wywoływać ją kilka razy z różnymi parametrami wejściowymi. No ale to już zależy od tego co miał autor na myśli, dlatego liczę na jakiś bardziej złożony przykład :stuck_out_tongue:


(Gregorsi) #11

Ja bym zrobił to tak:

http://sigreg.pl/pub/licz_punkty.xls

ewentualnie tak

http://sigreg.pl/pub/licz_punkty2.xls


(floyd) #12

Też bardzo elegancki sposób szczególnie ten pierwszy.

Jak widać istnieje wiele sposobów rozwiązania tego samego problemu. Który lepszy?

Na konkursach informatycznych mierzy się czas wykonywania algorytmu i wygrywa ten który jest najszybszy, ale żeby mierzyć czas to algorytm musi przetwarzać tysiące danych, a nie 10. :slight_smile:

Np. istnieje co najmniej 7 algorytmów sortowania.

Przy okazji przypomniała mi się taka opowiastka o Gausie. Nauczyciel polecił uczniom znaleźć sumę liczb od 1 do 100. Wszyscy liczyli: 1=2=3 3+4=7 itd. Gaus zauważył, że 1+100=101 2=99=101 3+98=101 , a takich par będzie 50 czyli 1+2 +3...+100=50*101=5050. Bystrzach był z tego Gausa. :slight_smile:

W dzisiejszych czasach to komputer by policzył tę sumę niezależnie od sposobu w tym samy czasie. :slight_smile:


(oprych) #13

Jeszcze raz dziękuje wszystkim za pomoc.

Zastosowałem rozwiązanie gregorsi - bardzo dziękuje.

Poniżej efekt mojej pracy.

Dzięki takiemu rozwiązaniu nie mam większych problemów jeśli musiałbym zwiększyć ilość klubów czy kategorii

http://lksceramik.pl/pliki/punktacja.xlsm

Mam już ostanie pytanie do tego problemu. Jak w makrze zapisać, aby pobierał ilość punktów za poszczególne miejsce z komórki?

Tak jak w moim przykładzie za I m. z komórki C30. Bo teraz jak zmieni się sposób punktacji, to muszę wpisywać to podwójnie pod tabelką i w makrze


(Tomek Matz) #14

Możesz to zrobić na dwa sposoby

  1. "na pałę", czyli

    miejscePunkty(1) = Cells(30,3) '30 wiersz, 3 kolumna

    miejscePunkty(2) = Cells(31,3) '31 wiersz, 3 kolumna

    miejscePunkty(3) = ...

  2. podmienić kod tej funkcji na taki:

    Public Function licz_punkty(miejsca As String)

    Dim listaMiejsc As Variant

    Dim n As Long

    Dim miejscePunkty(1 To 8) As Long

    Dim punkty As Long

    For n = LBound(miejscePunkty) To UBound(miejscePunkty)

    miejscePunkty(n) = Val(Trim(Cells(29 + n, 3)))

    Next n

    listaMiejsc = Split(miejsca, ",", -1, vbTextCompare)

    For n = LBound(listaMiejsc) To UBound(listaMiejsc)

    If listaMiejsc(n) <= 8 Then
    
        punkty = punkty + miejscePunkty(listaMiejsc(n))
    
    Else
    
        MsgBox "Błąd - Punkty po za zakresem", vbCritical, "Uwaga"
    
    End If

    Next n

    licz_punkty = punkty

    End Function

Ale jeśli użyjesz tej nowej wersji funkcji to popraw arkusz excela, bo nie masz wiersza z ilością punktów za 4 miejsce.

Miejsce Il. punktów

1 8

2 7

3 6

4 0

5 4

6 3

7 2

8 1

Swoją drogą, czemu za 4 miejsce jest 0 punktów :smiley: (tak miałeś w kodzie)


(floyd) #15

Przy takiej punktacji czyli za 1 miejsce-8pkt 2 miejsce-7 pkt itd

to nie potrzebna jest zmienna - miejsce punkty(n)

czyli można wyrzucić, to:

For n = LBound(miejscePunkty) To UBound(miejscePunkty)

    miejscePunkty(n) = Val(Trim(Cells(4 + n, 2)))

Next n

a linię:

punkty = punkty + miejscePunkty(listaMiejsc(n))

zastąpić tym:

punkty = punkty + 9 - listaMiejsc(n)

Czyli cała funkcja będzie miala postać:

Public Function licz_punkty(miejsca As String)

Dim listaMiejsc As Variant

Dim n As Long

Dim punkty As Long

listaMiejsc = Split(miejsca, ",", -1, vbTextCompare)

For n = LBound(listaMiejsc) To UBound(listaMiejsc)

 If listaMiejsc(n) <= 8 Then punkty = punkty + 9 - listaMiejsc(n)

Next n

licz_punkty = punkty

End Function

To ostrzeżenie *(MsgBox "Błąd - Punkty po za zakresem", vbCritical, "Uwaga") też bym wyrzucił. Po prostu za dalsze miejsca było by 0 punktów.


(Tomek Matz) #16

@floyd masz rację przy takiej punktacji Twój kod jest lepszy, ale ...


(oprych) #17

Po prostu w zapasach nie ma 4 miejsca, są dwa 3 a następne jest 5.

Punktacja też jest zmienna, w zależności od zawodów - raz punktują trzy pierwsze lokaty, innym razem 8 pierwszych.

Jeszcze raz serdecznie dziękuje :slight_smile:


(Tomek Matz) #18

Tego się nie spodziewałem :smiley: Zmodyfikowałem tamten kod, teraz będzie działać tak, że możesz podawać jako parametr także tabelę z numerami miejsc oraz tabelę z ilością punktów za te miejsca. Tabele te mogą być ustawione w pionie lub w poziomie (nie ma to znaczenia). Jedyny wymóg jest taki, żeby ilość elementów w tych tabelach była taka sama (co jest oczywiste :D). Elementy w tabelach mogą być wymieszane, czyli możesz mieć np.

Miejsce | Punkty

1 | 8

3 | 6

2 | 7

5 | 4

itd.

Nie musisz już wyszczególniać na tej liście miejsca numery 4 (ani żadnego innego jeśli nie będzie takiej potrzeby). No i oczywiście tabela z numerami miejsc może zawierać teraz dowolną liczbę miejsc (nie musi to już być dokładnie "8"), więc nie ma potrzeby dokonywania ręcznych zmian w kodzie. Tak wygląda kod:

Public Function licz_punkty(miejsca As String, _

                            Optional miejscaNumery As Range = Nothing, _

                            Optional miejscaPunkty As Range = Nothing)

Dim listaMiejsc() As String

Dim miejscePunkty() As Integer

Dim n, max, punkty As Integer


If miejscaNumery Is Nothing Then Set miejscaNumery = Range("A30:A36")

If miejscaPunkty Is Nothing Then Set miejscaPunkty = Range("C30:C36")


For n = 1 To miejscaNumery.Cells.Count

    If miejscaNumery(n).Value > max Then max = miejscaNumery(n).Value

Next n


ReDim miejscePunkty(1 To max) As Integer


For n = 1 To miejscaNumery.Cells.Count

    miejscePunkty(miejscaNumery(n).Value) = miejscaPunkty(n).Value

Next n


listaMiejsc = Split(miejsca, ",", -1, vbTextCompare)

For n = LBound(listaMiejsc) To UBound(listaMiejsc)

    If listaMiejsc(n) <= UBound(miejscePunkty) Then punkty = punkty + miejscePunkty(listaMiejsc(n))

Next n


licz_punkty = punkty

End Function

Jeśli nie określisz tabeli z numerami miejsc oraz tabeli z ilością punktów za tej miejsca, czyli nie wywołasz funkcji, np tak:

=licz_punkty(F36;A30:A36;C30:C36)

a wywołasz ją tak

=licz_punkty(F36)

to domyślnie zostanie przyjęte, że jako tabelę z numerami miejsc podałeś A30:A36, a jako tabelę z ilością punktów za te miejsca C30:C36 (te domyślne wartości możesz zmienić w kodzie jeśli zajdzie potrzeba). Jest to zrobione po to, że jak teraz podmienisz ten kod funkcji u siebie w arkuszu to będzie działać od razu i nie będziesz musiał nic edytować.

To już powinno wystarczyć.

Pozdrawiam.