[VB] Makro w excelu

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

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

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ł

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

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

pozdrawiam

Paweł

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ę ;)

dziękuję pięknie :)

Paweł