[VB] Makro w excelu

Odpowiedz Nowy wątek
2005-09-19 18:31
Krzychu
0

Kolega szuka pomocy, więc pomyślałem że może tu :)

Potrzebuję proste makro usuwające PL znaki zrobiłem cos takiego:

Function ogonki(TotalValue)

  TotalValue.Replace What:="ą", Replacement:="a", LookAt:=xlPart, SearchOrder _
      :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
  TotalValue.Replace What:="Ą", Replacement:="A", LookAt:=xlPart, SearchOrder _
      :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False

ogonki = TotalValue
End Function

W komórce A1 mam: Ąą
W komórce A2 mam: =ogonki(A1)

po wykonaniu się tego makra

W komórce A1 mam: Aa
W komórce A2 mam: Aa

Czyli prawie doskonale ale powinno być tak:

W komórce A1 mam: Ąą
W komórce A2 mam: Aa

Co zrobić aby nie modywikował mi komórki A1, normalnie przypisałbym zawartość komórki pod zmienną i na tej zmiennej bym dokonał usuniecia PL znaków, niestety VisualBasic jest mi trochę obcy

Może ktoś podpowie jak naprawić funkcję :D

Pozostało 580 znaków

2005-09-19 19:09
0

Jak chcesz uniknąć dodatkowych zmiennych, to najpierw przepisz do komórki docelowej, a potem na niej wywołaj podmianę znaków.


<font color="red">Konto porzucone</span>

Dzięki wszystkim forumowiczom za lata wspólnych dyskusji; miłej zabawy w programowanie!
Sławomir 'Szczawik' Włodkowski

Pozostało 580 znaków

2019-10-09 13:01
5

hej

W załączeniu przesyłam makro MS Excel popełnione parę lat temu i dość często przeze mnie używane. Można je umieścić w pliku personal.xlsb lub pliku *.xlam, aby funkcja była dostępna w każdym dokumencie.


Public Function Umlauts(Tekst)
    ' Zamienia znaki diakrytyczne: ąćęłńóśźżĄĆĘŁŃÓŚŹŻ
    ' na odpowiadające im znaki bez ogonków: acelnoszzACELNOSZZ
    strTekst = Tekst
    strTekst = Replace(strTekst, Chr(185), Chr(97), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(230), Chr(99), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(234), Chr(101), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(179), Chr(108), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(241), Chr(110), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(243), Chr(111), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(156), Chr(115), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(159), Chr(122), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(191), Chr(122), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(165), Chr(65), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(198), Chr(67), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(202), Chr(69), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(163), Chr(76), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(209), Chr(78), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(211), Chr(79), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(140), Chr(83), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(143), Chr(90), , , vbBinaryCompare)
    strTekst = Replace(strTekst, Chr(175), Chr(90), , , vbBinaryCompare)

    Umlauts = strTekst
End Function

Powyższa funkcja działa poprawnie dla kodowania Windows-1250.
--
pozdrawiam
Paweł

edytowany 3x, ostatnio: Pawel L., 2019-10-09 13:12

Pozostało 580 znaków

2019-10-09 13:21
5

14 lat to całkiem niezły wynik :D

screenshot-20191009132115.png


That game of life is hard to play
I'm gonna lose it anyway
The losing card I'll someday lay
So this is all I have to say

Pozostało 580 znaków

2019-10-09 13:31
1

Nie jestem stałym użytkownikiem forum. Jak widzisz to mój pierwszy post tu.
Może jeszcze komuś się przyda. :D

pozdrawiam
--
Paweł

edytowany 1x, ostatnio: Pawel L., 2019-10-09 13:31

Pozostało 580 znaków

2019-10-09 13:33
0

Wiem, widziałem że jesteś początkujący, a post rzeczywiście może być przydatny - dlatego go nie skasowałem, tylko dałem Ci łapkę ;)


That game of life is hard to play
I'm gonna lose it anyway
The losing card I'll someday lay
So this is all I have to say
edytowany 1x, ostatnio: cerrato, 2019-10-09 13:33

Pozostało 580 znaków

2019-10-09 13:44
0

dziękuję pięknie :)
--
Paweł

Pozostało 580 znaków

Odpowiedz
Liczba odpowiedzi na stronę

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0