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: 52379 Skopiuj do schowka Odmiana liczebników i przez przypadki
Autor Wiadomość
Artik 



Wersja: Win Office 365
Pomógł: 2625 razy
Posty: 8661
Wysłany: 23-05-2016, 01:33   Odmiana liczebników i przez przypadki

Niejednokrotnie zdarza się budować komunikaty dla użytkownika, gdzie mile widzianym byłoby stosowanie właściwej odmiany liczebników i/lub przez przypadki. Na skróty, budujemy protezę, by ominąć zawiłości naszego języka.
Zamiast:
Cytat:
Pobrano 21 plików (23 pliki)
budujemy
Cytat:
Liczba pobranych plików: 21 (23)

Gdzie można, to można, ale są sytuacje, gdzie nie wypada. :-) Klient będzie mile zaskoczony, gdy będzie mógł przeczytać komunikat poprawną polszczyzną.

Okazuje się, że tak odmianę liczebników jak i przez przypadki można zrealizować dosyć prostymi funkcjami.
Ale...
Spokojnie, nie podpalać się za bardzo. Gdyby funkcje bez naszej ingerencji odmieniały słowa, to na pewno nie znalazłyby się w tym dziale, tylko na stronie, gdzie można byłoby je sobie pobrać za odpowiednią opłatą. :-)
Niestety, funkcje proste, ale wkład własny musi być. Trzeba zdefiniować odmianę słów w zorganizowanych tabelach. Dopiero na końcu możemy się cieszyć w miarę prostym sposobem odmiany słów.

Artik

Liczebniki - odmiana słów.xlsm
Pobierz Plik ściągnięto 247 raz(y) 27.32 KB

ID posta: 293927 Skopiuj do schowka
 
 
partner2001 
Exceloholic


Posty: 122
Wysłany: 18-05-2017, 14:41   

Świetna robota.
Mam tylko pytanie jak wpisywać argumenty sPzypadek. Po wpisaniu "D" funkcja nie rozpoznaje argumentu.
_________________
Dziękuję za pomoc.
Pozdrawiam
Leszek
ID posta: 322916 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2625 razy
Posty: 8661
Wysłany: 19-05-2017, 01:18   

Proszę o dowód, bo na słowo nie wierzę. :-)

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 322945 Skopiuj do schowka
 
 
partner2001 
Exceloholic


Posty: 122
Wysłany: 19-05-2017, 10:16   Załączam plik

W komórkach wyróżnionych żółtym kolorem wprowadziłem przykładowe formuły.
Wszystko jest na pewno dobrze u Ciebie ale ja robię jakiś błąd i nie wiem jaki.

Liczebniki - odmiana słów z formułami.xlsm
Pobierz Plik ściągnięto 119 raz(y) 27.72 KB

_________________
Dziękuję za pomoc.
Pozdrawiam
Leszek
ID posta: 322956 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2625 razy
Posty: 8661
Wysłany: 19-05-2017, 11:23   

No, kochaneńki. Jest wyraźnie napisane w komentarzach, że funkcje wymagają OBIEKTU tabeli, a nie jej zakresu.
Dotychczas, funkcje nie były dostosowane do użytkowania w formułach arkuszowych. Więc może czas to zmienić. :-)
Parę klepnięć palcami u nóg w klawiaturę ;-) i może tak będzie lepiej:
Kod:
'---------------------------------------------------------------------------------------
' Author    : Artik
' Date      : 2016-05-22
' Purpose   : odmiana polskich wyrazów
'             Funkcje Liczebnik() i Przypadek() wymagają obecności tabeli (obiektu)
'             w takim układzie jak pokazano w arkuszu
'---------------------------------------------------------------------------------------


Function Przypadek(Slowo As String, sPrzypadek As String, ByVal Tabela As Object) As String
  ' Revision  : 2017-05-19 (dodanie możliwości zastosowania w formule)

    'Slowo - słowo, które będzie poszukiwane w pierwszej kolumnie tabeli,
    '        by określić numer wiersza (r). Kolumna ta powinna zawierać unikaty!
    'sPrzypadek:
    'M - kto, co
    'D - kogo, czego
    'C - komu, czemu
    'B - kogo, co
    'N - z kim, z czym
    'Ms - o kim, o czym
    'W - o!
    'sPrzypadek - słowo poszukiwane w nagłówku tabeli, by określić numer kolumny (c)
    'Tabela - odwołanie do obiektu tabela (przy wywołaniu z kodu) lub _
              odwołanie do zakresu zawierającego tabelę (przy wywołaniu z formuły) w wybranym arkuszu.

    Dim r As Long, c As Long
    Dim rng         As Range
    Dim Tbl         As ListObject

    'Application.Volatile
   
    If TypeName(Tabela) = "Range" Then
        For Each Tbl In Tabela.Parent.ListObjects
            If Tbl.Range.Address(External:=True) = Tabela.Address(External:=True) Then
                Exit For
            End If
        Next Tbl
    ElseIf TypeName(Tabela) = "ListObject" Then
        Set Tbl = Tabela
    End If
   
    Set rng = Tbl.DataBodyRange

    If rng Is Nothing Then
        Przypadek = "Brak słownika!"
        Exit Function
    End If

    On Error Resume Next

    With Tbl.DataBodyRange
        r = Application.Match(Slowo, .Columns(1), 0)
        c = Application.Match(sPrzypadek, Tbl.HeaderRowRange, 0)

        If Err.Number <> 0 Then
            Przypadek = "Brak w słowniku!"
        Else
            'Jl. słowo zostało znalezione łączymy rdzeń znalezionego słowa z końcówką we wskazanym przypadku
            Przypadek = .Cells(r, 2).Value & .Cells(r, c).Value
        End If
    End With

    On Error GoTo 0
End Function


Function Liczebnik(Slowo As String, Ilosc As Long, Tabela As Object) As String
  ' Revision  : 2017-05-19 (dodanie możliwości zastosowania w formule)

    'funkcja powstała na bazie algorytmu Romualda Żyłły
    'http://zylla.wipos.p.lodz.pl/ut/Liczebniki.html

    Dim r As Long, c As Long
    Dim N0 As Long, N1 As Long, N2 As Long
    Dim R0          As String
    Dim rdzen       As String
    Dim rng         As Range
    Dim Tbl         As ListObject

    'Application.Volatile

    If TypeName(Tabela) = "Range" Then
        For Each Tbl In Tabela.Parent.ListObjects
            If Tbl.Range.Address(External:=True) = Tabela.Address(External:=True) Then
                Exit For
            End If
        Next Tbl
    ElseIf TypeName(Tabela) = "ListObject" Then
        Set Tbl = Tabela
    End If

    Set rng = Tbl.DataBodyRange

    If rng Is Nothing Then
        Liczebnik = "Brak słownika!"
        Exit Function
    End If

    With Tbl.DataBodyRange
        On Error Resume Next

        r = Application.Match(Slowo, .Columns(1), 0)

        If Err.Number = 0 Then
            On Error GoTo 0

            rdzen = .Cells(r, 2).Value
            N0 = Ilosc
            N1 = N0 Mod 10
            N2 = N0 Mod 100

            If N0 = 1 Then
                R0 = .Cells(r, 3).Value
            ElseIf N2 > 4 And N2 < 22 Then
                R0 = .Cells(r, 5).Value
            ElseIf N1 > 1 And N1 <= 4 Then
                R0 = .Cells(r, 4).Value
            Else
                R0 = .Cells(r, 5).Value
            End If
        Else
            rdzen = "Brak w słowniku!"
        End If
    End With

    Liczebnik = rdzen & R0

End Function
Acz przyznam, że nie przemyśliwałem dogłębnie ewentualnych zagrożeń po zmianie kodu.

Artik
ID posta: 322967 Skopiuj do schowka
 
 
partner2001 
Exceloholic


Posty: 122
Wysłany: 19-05-2017, 12:39   

Coś nie za bardzo mi to działa.
Po wymienieniu kodu prawie wszystko mam na czerwono (w kodzie)
_________________
Dziękuję za pomoc.
Pozdrawiam
Leszek
ID posta: 322977 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2625 razy
Posty: 8661
Wysłany: 19-05-2017, 22:39   

http://www.excelforum.pl/viewtopic.php?p=322945 :-)

Artik
ID posta: 323005 Skopiuj do schowka
 
 
partner2001 
Exceloholic


Posty: 122
Wysłany: 22-05-2017, 10:29   

Wstawiłem do nowego pliku i działa super.
Serdeczne dzięki.
A czy możesz mi powiedzieć jak stworzyć OBIEKT tabeli.
Pozdrawiam
_________________
Dziękuję za pomoc.
Pozdrawiam
Leszek
ID posta: 323065 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 2625 razy
Posty: 8661
Wysłany: 23-05-2017, 02:13   

Twoje pytanie zdecydowanie odbiega już od tematyki tego wątku.

Artik
_________________
Persistence is a virtue in the world of programming.
ID posta: 323130 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.marketingNET.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