Forum Coders' city Strona Główna Coders' city
Nasza pasja to programowanie!
 

 PomocPomoc   SzukajSzukaj   UżytkownicyUżytkownicy   GrupyGrupy  RejestracjaRejestracja 
Archiwum starego forum + teoria    RSS & Panel/SideBar
 ProfilProfil   Zaloguj się, by sprawdzić wiadomościZaloguj się, by sprawdzić wiadomości   ZalogujZaloguj 

Potrzebuję szybkiej odpowiedzi na moje pytanie... Zasady

[Excel 2016] Wyciągniecie pierwszych liter wyrazów



 
Odpowiedz do tematu    Forum Coders' city Strona Główna -> Oprogramowanie biurowe
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
christophersss



Dołączył: 23 Maj 2011
Posty: 48

PostWysłany: Pon Wrz 11, 2017 10:51 am  OP    Temat postu: [Excel 2016] Wyciągniecie pierwszych liter wyrazów Odpowiedz z cytatem Pisownia

Witam,
Przeszukałem wszystko ale nigdzie nie znalazłem, mam w komórce powiedzmy A wpis - Powszechny Zakład Ubezpieczeń, chciałbym formuła zamienić to na PZU czyli wyciągnąć pierwsze litery wyrazów, bede wdzieczny za odpowiedź
Pozdro
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
karolinavb
Site Admin


Dołączył: 25 Maj 2005
Posty: 7827

PostWysłany: Pon Wrz 11, 2017 8:43 pm      Temat postu: Odpowiedz z cytatem Pisownia

W module standardowym:
Kod:
Public Function Pierwsze(ByVal sText As String) As String
    Application.Volatile               ' jesli chcesz uzyc w komórce np--> =Pierwsze(A1)
    Dim Arr
    Dim strWyn                    As String
    Dim w                         As Long
    sText = WorksheetFunction.Trim(sText)
    If Len(sText) = 0 Then Exit Function
    Arr = Split(sText, " ")
    sText = UCase(Left(Arr(0), 1))
    For w = 1 To UBound(Arr)
        sText = sText & UCase(Left(Arr(w), 1))
    Next
    Pierwsze = sText
End Function
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
samolot



Dołączył: 26 Sty 2006
Posty: 8171
Skąd: Toruń

PostWysłany: Pon Wrz 11, 2017 8:44 pm      Temat postu: Odpowiedz z cytatem Pisownia

1. Należy pobrać z komórki wpis "Powszechny Zakład Ubezpieczeń"
2. Podzielić go na poszczególne wyrazy funkcją Split() względem spacji.
3. Z każdego wyrazu pobrać pierwszy znak funkcją Left()
4. Ewentualnie pobrane znaki zmienić z małych na duże funkcją Ucase()
5. Połączyć znaki w jeden ciąg i gotowe

_________________
Nie zadawaj bezcelowych pytań / Windows 8.1 / Windows 10 / VB2008 / VB 2010 / VB 2012 / Pisz poprawnie
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Wyślij email
christophersss



Dołączył: 23 Maj 2011
Posty: 48

PostWysłany: Wto Wrz 12, 2017 7:48 am  OP    Temat postu: . Odpowiedz z cytatem Pisownia

Bardzo Dziękuje za okazaną pomoc, jeszcze tylko drobne dopytanie w kolumnie mam Powszechny Zakład Ubezpieczeń/oddział katowice/ul. korfantego. i chciałbym aby ten kod od Karoliny działał ale tylko do pierwszego "/"? gdzie to dodać w kodzie. pozdr
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
jacekq



Dołączył: 13 Kwi 2006
Posty: 2204
Skąd: Wrocław

PostWysłany: Sro Wrz 13, 2017 9:18 am      Temat postu: Odpowiedz z cytatem Pisownia

2a. Podzielić go na poszczególne wyrazy funkcją Split() względem "/".
2b. Wziąć tylko element 0 z tablicy wynikowej tego podzielenia. :)
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Wyślij email
michson



Dołączył: 21 Sie 2013
Posty: 1

PostWysłany: Czw Wrz 14, 2017 7:18 pm      Temat postu: Odpowiedz z cytatem Pisownia

Docelowy kod to:
Kod:
Function Literki(ByVal tekst As String) As String
Application.Volatile
tekst = VBA.Trim(tekst)
If Len(tekst) = 0 Then Exit Function

tbl = Split(tekst, "/")(0)
tbl = Split(tbl, " ")

For i = LBound(tbl) To UBound(tbl)
  t = t & UCase(Left(tbl(i), 1))
Next
Literki = t
End Function
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
karolinavb
Site Admin


Dołączył: 25 Maj 2005
Posty: 7827

PostWysłany: Czw Wrz 14, 2017 7:34 pm      Temat postu: Odpowiedz z cytatem Pisownia

Użyłam celowo:
Cytat:
WorksheetFunction.Trim
a nie
Cytat:
VBA.Trim
Jest między nimi różnica !!!!
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
exbs



Dołączył: 03 Lut 2015
Posty: 13
Skąd: Matrix

PostWysłany: Czw Wrz 14, 2017 8:20 pm      Temat postu: Odpowiedz z cytatem Pisownia

Zawsze można tak:
Kod:
Function Literki(ByVal tekst As String) As String
Application.Volatile
tekst = application.Trim(tekst)
If Len(tekst) = 0 Then Exit Function

tbl = Split(tekst, "/")(0)
tbl = Split(tbl, " ")

For i = LBound(tbl) To UBound(tbl)
  t = t & UCase(Left(tbl(i), 1))
Next
Literki = t
End Function

_________________
Pozdrawiam
Michał
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
jacekq



Dołączył: 13 Kwi 2006
Posty: 2204
Skąd: Wrocław

PostWysłany: Czw Wrz 14, 2017 9:26 pm      Temat postu: Odpowiedz z cytatem Pisownia

Application.Trim to jest dokładnie to samo co Application.WorksheetFunction.Trim.
Przy czym pierwsza wersja jest przestarzała, niezalecana zatem (i nieobsługiwana przez IntelliSense), ale działa ze względu na wsteczną kompatybilność. :)
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Wyślij email
Wyświetl posty z ostatnich:   
Odpowiedz do tematu    Forum Coders' city Strona Główna -> Oprogramowanie biurowe Wszystkie czasy w strefie CET (Europa)

Strona 1 z 1

 
Skocz do:  
Możesz pisać nowe tematy
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
Możesz dodawać załączniki na tym forum
Możesz pobierać pliki z tego forum




Debug: strone wygenerowano w 0.18748 sekund, zapytan = 11
contact

| Darmowe programy i porady Jelcyna | Tansze zakupy w Helionie | MS Office Blog |