Witam
Poszukuje formuły która umożliwiałaby zliczanie punktów za poszczególne miejsce
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
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 iPrzykł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 SubDzię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
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.
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.
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. 
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 SubZmieniaj dowolnie, byle żeby było lepiej 
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).
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.
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
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.
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.
W dzisiejszych czasach to komputer by policzył tę sumę niezależnie od sposobu w tym samy czasie.
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
Możesz to zrobić na dwa sposoby
“na pałę”, czyli
miejscePunkty(1) = Cells(30,3) '30 wiersz, 3 kolumna
miejscePunkty(2) = Cells(31,3) '31 wiersz, 3 kolumna
miejscePunkty(3) = …
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 
(tak miałeś w kodzie)
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.
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
Tego się nie spodziewałem 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.