Skocz do zawartości


Close Open
Close Open
Zdjęcie
- - - - -

zamiana polskich znakow w excelu


  • Please log in to reply
6 replies to this topic

#1 sapcio_lodz

sapcio_lodz

    Adept

  • Forumowicze
  • Pip
  • 9 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Łódź, Polska

Napisany 23 wrzesień 2009 - 07:56

czy istnieje może jakaś funkcja w excelu która zamienia dany string w którym są polskie znaki na string bez tych znaków?

np: "Kraków" -> "Krakow"

jeśli nie ma takiej funkcji to może ktoś ma jakiś pomysł jak to zrobić?

#2 Anrzelika

Anrzelika

    pani majster ;)

  • Forumowicze
  • PipPipPipPipPipPipPipPip
  • 8652 Postów:
  • Płeć:Kobieta

Napisany 23 wrzesień 2009 - 08:05

Tak lopatologicznie to jest trywialne:

Wybieramy w menu (ew. Ctrl+H): Edycja -> zamień...

Znajdź: ó
Zamień na: o
Zamień wszystko

Nie jest to moze elegancka metoda, ale dziala...

Sapphire Z77 Pure Platinum, Intel Celeron G1610,
Corsair DDR3 1600MHz 16GB, Enermax Pro87+ 500W,
Samsung MZ-7PC064, Samsung HD502HJ, HIS HD4670,
Antec Three Hundred, Thermalright HR-01, HR-03.


#3 sapcio_lodz

sapcio_lodz

    Adept

  • Forumowicze
  • Pip
  • 9 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Łódź, Polska

Napisany 23 wrzesień 2009 - 08:52

Tak lopatologicznie to jest trywialne:

Wybieramy w menu (ew. Ctrl+H): Edycja -> zamień...

Znajdź: ó
Zamień na: o
Zamień wszystko

Nie jest to moze elegancka metoda, ale dziala...


tak to wiem ze mozna by zrobic
ale chodzi mi o automatyczna zmiane bo potrzebuje tego w formularzu ktory bedzie rozsylany, wiec nie bede nad wszytkimi czuwal :)

#4 tkuchta1

tkuchta1

    Uczestnik

  • Forumowicze
  • PipPipPipPip
  • 103 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Zakopane, Polska

Napisany 23 wrzesień 2009 - 12:31

mi wyszło tak
Option Explicit

Function StringBezPlZnakow(strCiag As String) As String
	Dim arrFind As Variant, arrReplace As Variant, iArr As Integer
	Dim i As Integer, temp As String
	
	   arrFind = Array("ą", "ć", "ę", "ń", "ó", "Ą", "Ę", "Ć")
	arrReplace = Array("a", "c", "e", "n", "o", "A", "E", "C")

	temp = strCiag
	For i = 1 To Len(temp)
		If Asc(Mid(temp, i, 1)) > 122 Then
			For iArr = LBound(arrFind) To UBound(arrFind)
				If Mid(temp, i, 1) = arrFind(iArr) Then
					temp = VBA.Replace(Expression:=temp, _
									   Find:=arrFind(iArr), _
									   Replace:=arrReplace(iArr))
					Exit For
				End If
			Next
		End If
	Next
	StringBezPlZnakow = temp
End Function
uzupełnij tablice o brakujące znaki i ich odpowiedniki :-)

#5 sapcio_lodz

sapcio_lodz

    Adept

  • Forumowicze
  • Pip
  • 9 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Łódź, Polska

Napisany 23 wrzesień 2009 - 14:38

mi wyszło tak

Option Explicit

Function StringBezPlZnakow(strCiag As String) As String
	Dim arrFind As Variant, arrReplace As Variant, iArr As Integer
	Dim i As Integer, temp As String
	
	   arrFind = Array("ą", "ć", "ę", "ń", "ó", "Ą", "Ę", "Ć")
	arrReplace = Array("a", "c", "e", "n", "o", "A", "E", "C")

	temp = strCiag
	For i = 1 To Len(temp)
		If Asc(Mid(temp, i, 1)) > 122 Then
			For iArr = LBound(arrFind) To UBound(arrFind)
				If Mid(temp, i, 1) = arrFind(iArr) Then
					temp = VBA.Replace(Expression:=temp, _
									   Find:=arrFind(iArr), _
									   Replace:=arrReplace(iArr))
					Exit For
				End If
			Next
		End If
	Next
	StringBezPlZnakow = temp
End Function
uzupełnij tablice o brakujące znaki i ich odpowiedniki :-)



dzieki wielkie za pomoc

Dodano 23-09-2009 15:38:07:

mi wyszło tak

Option Explicit

Function StringBezPlZnakow(strCiag As String) As String
	Dim arrFind As Variant, arrReplace As Variant, iArr As Integer
	Dim i As Integer, temp As String
	
	   arrFind = Array("ą", "ć", "ę", "ń", "ó", "Ą", "Ę", "Ć")
	arrReplace = Array("a", "c", "e", "n", "o", "A", "E", "C")

	temp = strCiag
	For i = 1 To Len(temp)
		If Asc(Mid(temp, i, 1)) > 122 Then
			For iArr = LBound(arrFind) To UBound(arrFind)
				If Mid(temp, i, 1) = arrFind(iArr) Then
					temp = VBA.Replace(Expression:=temp, _
									   Find:=arrFind(iArr), _
									   Replace:=arrReplace(iArr))
					Exit For
				End If
			Next
		End If
	Next
	StringBezPlZnakow = temp
End Function
uzupełnij tablice o brakujące znaki i ich odpowiedniki :-)

tylko jeszcze male pytanie
jak dodac to makro?

#6 navstevnik

navstevnik

    Początkujący

  • Forumowicze
  • PipPipPip
  • 73 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Ostrava, Czechy

Napisany 23 wrzesień 2009 - 14:40

lub tak:
Sub BezPlZnakow()
  Dim Cll As Range
  Dim Area As Range
  Dim PoleS()
  Dim PoleBez()

  Application.ScreenUpdating = False

  PoleS = Array("ą", "ć", "ę", "ń", "ó", "Ą", "Ę", "Ć") '....
  PoleBez = Array("a", "c", "e", "n", "o", "A", "E", "C") '....

  For Each Cll In ActiveSheet.Range("C1:C5").Cells
	' lub
	'For Each Cll In ActiveSheet.UsedRange
	If (Not Cll.HasFormula) Then
	  If Area Is Nothing Then Set Area = Cll
	  Set Area = Union(Area, Cll)
	End If
  Next Cll

  For i = 0 To 7 '....
	Area.Replace What:=PoleS(i), Replacement:=PoleBez(i), _
		LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True
  Next i

  Application.ScreenUpdating = True

End Sub


#7 tkuchta1

tkuchta1

    Uczestnik

  • Forumowicze
  • PipPipPipPip
  • 103 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Zakopane, Polska

Napisany 23 wrzesień 2009 - 17:40

Napisałem funkcję więc używaj jak funkcji
Option Explicit



Sub BezPolskichZnakow()

	Dim wks As Excel.Worksheet

	Dim rngTextValues As Excel.Range, rngCell As Excel.Range

	

	Set wks = ThisWorkbook.Worksheets("Arkusz1")

	On Error Resume Next

	Set rngTextValues = wks.Range("A1:E10").SpecialCells(xlCellTypeConstants, xlTextValues)

	On Error GoTo 0

	

	Application.ScreenUpdating = False

	If Not rngTextValues Is Nothing Then

		For Each rngCell In rngTextValues

			rngCell = StringBezPlZnakow(rngCell.Value)

		Next

	Else

		MsgBox "nie ma co zmieniać", vbExclamation

	End If

	Application.ScreenUpdating = True

	

	Set wks = Nothing

	Set rngTextValues = Nothing



End Sub



Function StringBezPlZnakow(strCiag As String) As String

	Dim arrFind As Variant, arrReplace As Variant, iArr As Integer

	Dim i As Integer, temp As String

	

	   arrFind = Array("ą", "ć", "ę", "ń", "ó", "Ą", "Ę", "Ć")

	arrReplace = Array("a", "c", "e", "n", "o", "A", "E", "C")



	temp = strCiag

	For i = 1 To Len(temp)

		If Asc(Mid(temp, i, 1)) > 122 Then

			For iArr = LBound(arrFind) To UBound(arrFind)

				If Mid(temp, i, 1) = arrFind(iArr) Then

					temp = VBA.Replace(Expression:=temp, _

									   Find:=arrFind(iArr), _

									   Replace:=arrReplace(iArr))

					Exit For

				End If

			Next

		End If

	Next

	StringBezPlZnakow = temp

End Function





0 Użytkowników czyta ten temat

0 użytkowników, 0 gości, 0 anonimowych użytkowników