Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek dla www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

excel - konwersja nazw ulic

03 Lut 2010 08:44 3311 13
  • Poziom 9  
    Witam

    Mam w excelu kolumnę #1 z nazwami ulic i adresami ok. 30 000 pozycji np.

    Code:

    WSPOLNA         1
    WSPOLNA         2
    WSPOLNA         3
    WYSPIANSKIEGO      1
    WYSPIANSKIEGO      2
    ZBOZOWA          1
    ZBOZOWA          2
    ZBOZOWA          3
    ZBOZOWA         4


    Jak widać nazwy bez polskich znaków. Numery ulic w osobnej kolumnie tutaj dane tylko dla przykładu. Mam też poprawny spis wszystkich ulic ok. 1000 w osobnej tabeli czyli

    Code:
    Wspólna         
    
    Wyspiańskiego
    Zbożowa


    Potrzebowałbym zamienić nazwy ulic z kolumny #1 na poprawne. Bardzo proszę o pomoc jak by to zrobić automatem. Z góry dziękuję za pomoc. Pozdrawiam
    Darmowe szkolenie: Ethernet w przemyśle dziś i jutro. Zarejestruj się za darmo.
  • Użytkownik usunął konto  
  • Poziom 9  
    Ojej, CTRL + H to będzie sporo pracy :/. Gdyby to była jednorazowa sprawa to może i tak ale będzie mi to jeszcze potrzebne w późniejszym czasie. Excel to 2002 ale nie m problemu, mogę mieć jakikolwiek ... . Jakieś inne sugestie ?
  • Użytkownik usunął konto  
  • Poziom 9  
    Dodałem plik jako załącznik. ctrl + H to dużo roboty szczególnie, że mam kilka plików do zamiany no i żeby było mało np w jednym arkuszu w kolumnie A i C jest ten sam zakres ulic ale np ulica w A5 nie jest ta sama co w C5 (w ok 20 % przypadków)
  • Użytkownik usunął konto  
  • Poziom 9  
    wiem to tylko, że jak pisałem to nie jest jeden arkusz (tylko kilka i w następnych ulice już nie są te same) i sytuacja potrzeby zmiany będzie się powtarzać niestety dlatego myślę nad zautomatyzowaniem tej zamiany.
  • Pomocny post
    Moderator Programowanie
    Jedyne co przychodzi mi do głowy to makro z wykorzystaniem kolumny z prawidłowymi nazwami. W przykładzie zamiana polskich liter, porównanie, podstawienie. Trochę długo trwa, należałoby pewnie dopracować, ale działa (w arkuszu autora).
    Code:
    Sub zamien()
    
    Dim i As Long, kom As Range, tekst As String
    For i = 2 To Range("B65536").End(xlUp).Row
      tekst = WorksheetFunction.Substitute(Cells(i, 2), "ą", "a")
      tekst = WorksheetFunction.Substitute(tekst, "ć", "c")
      tekst = WorksheetFunction.Substitute(tekst, "ę", "e")
      tekst = WorksheetFunction.Substitute(tekst, "ł", "l")
      tekst = WorksheetFunction.Substitute(tekst, "Ł", "L")
      tekst = WorksheetFunction.Substitute(tekst, "ń", "n")
      tekst = WorksheetFunction.Substitute(tekst, "ó", "o")
      tekst = WorksheetFunction.Substitute(tekst, "ś", "s")
      tekst = WorksheetFunction.Substitute(tekst, "Ś", "S")
      tekst = WorksheetFunction.Substitute(tekst, "ż", "z")
      tekst = WorksheetFunction.Substitute(tekst, "Ż", "Z")
      tekst = WorksheetFunction.Substitute(tekst, "ź", "z")
      For Each kom In Range("A2:A" & Range("A65536").End(xlUp).Row)
        If UCase(kom) = UCase(tekst) Then
          kom.Value = Cells(i, 2)
        Else
          kom = StrConv(kom, vbProperCase)
        End If
      Next
    Next
    End Sub

    Można ograniczyć do nazw z polskimi znakami, co znacznie skróci czas wykonywania makra.
  • Poziom 9  
    No to jesteśmy bardzo blisko :). Niestety nie znam VBA więc prosiłbym o podpowiedź jak by wyglądała funkcja automatycznej (czyli taki automat ctrl+H) zmiany coś w stylu:
    if Nn=ZAKRETOW* then Nn = Zakrętów (N; A-Z ..., n; 1-20000). Oczywiście trzeba by wpisać ręcznie wszystkie ulice w takim skrypcie co mogę zrobić. Proszę tylko o krótki przykład. No i żeby zmieniał w całym arkuszu a do tego żeby podobnie jak ctrl-H interpretował "*" czyli ZAKRETOWsssss lub ZAKRETOWqqqqqq też zmienił na Zakrętów. Jakby się udało to będę w domu :)
  • Moderator Programowanie
    almurik napisał:
    czyli ZAKRETOWsssss lub ZAKRETOWqqqqqq też zmienił na Zakrętów.
    Podmień
    Code:
    If UCase(kom) = UCase(tekst) Then
    na
    Code:
    If Mid(UCase(kom), 1, Len(tekst)) = UCase(tekst) Then
  • Poziom 15  
    A nie byłoby szybciej zrobić kwerendy w Accesie i wyeksportować gotowca do excela :|
  • Poziom 9  
    bardzo prosiłbym jeszcze o pomoc przy skrypcie, który po zamianie porówna mi każdy wpis z kolumny A z wpisami z kolumny B i np w kolumnie C wypluje "błąd" jeżeli wpis w A nie pasuje do żadnego wpisu z B. Pewnie będzie to liczył długo ale to nie problem.

    Niestety proszę o gotowca bo co prawda zainteresowałem się vba ale potrzebuję to na w miarę szybko. Z góry bardzo dziękuję.
  • Moderator Programowanie
    Może wstawić licznik w wewnętrznej pętli i jeśli równy 0 to błąd...
    Code:

      licznik=0
      For Each kom In Range("A2:A" & Range("A65536").End(xlUp).Row)
        If UCase(kom) = UCase(tekst) Then
          kom.Value = Cells(i, 2)
          licznik=licznik+1
        Else
          kom = StrConv(kom, vbProperCase)
        End If
      Next
      If licznik=0 Then Cells(i, 3) = "błąd"
  • Poziom 9  
    Ok doszedłem do ładu z tematem i po kilku dniach pierwszego kontaktu z VBA wypłodziłem z pomocą elektrody kilka skryptów, może się komuś przyda więc wkleję.
    kolumna
    B - zakres ulic poprawnych
    C - ulice poprawne
    G - ulice do poprawienia
    H - błędy sprawdzania

    Kolejność C koniecznie Z->A

    Obliczenie zakresów
    Code:

    Private Sub zakres_Click()
    Dim i As Long, zajete As Long, ulica1 As String, ulica As String, ulicam As String, ulicaw As String
    czas = Range("C65536").End(xlUp).Row
    Range("B2:B65536").Value = ""
    For i = 2 To Range("C65536").End(xlUp).Row
    zajete = Range("B65536").End(xlUp).Row
        ulica = Replace(Cells(i, 3), " ", "")
        ulica = Replace(ulica, "ą", "a")
        ulica = Replace(ulica, "ć", "c")
        ulica = Replace(ulica, "ę", "e")
        ulica = Replace(ulica, "ł", "l")
        ulica = Replace(ulica, "Ł", "L")
        ulica = Replace(ulica, "ń", "n")
        ulica = Replace(ulica, "ó", "o")
        ulica = Replace(ulica, "ś", "s")
        ulica = Replace(ulica, "Ś", "S")
        ulica = Replace(ulica, "ż", "z")
        ulica = Replace(ulica, "Ż", "Z")
        ulica = Replace(ulica, "ź", "z")
        ulica = Replace(ulica, "Ź", "Z")
        ulica = UCase(Mid(ulica, 1, 1))
       
        ulicam = Replace(Cells(i - 1, 3), " ", "")
        ulicam = Replace(ulicam, "ą", "a")
        ulicam = Replace(ulicam, "ć", "c")
        ulicam = Replace(ulicam, "ę", "e")
        ulicam = Replace(ulicam, "ł", "l")
        ulicam = Replace(ulicam, "Ł", "L")
        ulicam = Replace(ulicam, "ń", "n")
        ulicam = Replace(ulicam, "ó", "o")
        ulicam = Replace(ulicam, "ś", "s")
        ulicam = Replace(ulicam, "Ś", "S")
        ulicam = Replace(ulicam, "ż", "z")
        ulicam = Replace(ulicam, "Ż", "Z")
        ulicam = Replace(ulicam, "ź", "z")
        ulicam = Replace(ulicam, "Ź", "Z")
        ulicam = UCase(Mid(ulicam, 1, 1))
       
        ulicaw = Replace(Cells(i + 1, 3), " ", "")
        ulicaw = Replace(ulicaw, "ą", "a")
        ulicaw = Replace(ulicaw, "ć", "c")
        ulicaw = Replace(ulicaw, "ę", "e")
        ulicaw = Replace(ulicaw, "ł", "l")
        ulicaw = Replace(ulicaw, "Ł", "L")
        ulicaw = Replace(ulicaw, "ń", "n")
        ulicaw = Replace(ulicaw, "ó", "o")
        ulicaw = Replace(ulicaw, "ś", "s")
        ulicaw = Replace(ulicaw, "Ś", "S")
        ulicaw = Replace(ulicaw, "ż", "z")
        ulicaw = Replace(ulicaw, "Ż", "Z")
        ulicaw = Replace(ulicaw, "ź", "z")
        ulicaw = Replace(ulicaw, "Ź", "Z")
        ulicaw = UCase(Mid(ulicaw, 1, 1))
       
        If ulica <> ulicam Then
            If ulica = ulicaw Then
            Cells(zajete + 1, 2) = i - 1
            Cells(i, 2) = i
            End If
            If ulica <> ulicaw Then
            Cells(zajete + 1, 2) = i - 1
            Cells(i, 2) = i
            End If
        End If
       
    'STATUS BAR
    Application.DisplayStatusBar = True
    With Application
    .ScreenUpdating = False
    .Cursor = xlWait
    .StatusBar = "Czekaj... - trwa obliczanie pola " & i & " z " & czas
    End With
    With Application
    .ScreenUpdating = True
    .Cursor = xlDefault
    .StatusBar = False
    End With
    ' END Status BAR
    Next
    zajete = Range("B65536").End(xlUp).Row
    Cells(zajete + 1, 2) = Range("C65536").End(xlUp).Row
    End Sub


    Poprawienie

    Code:

    Private Sub zmiana_Click()
    Dim i As Long, j As Long, ulica As Range, ulica2 As String, popr As String, czas As String, licznik As String, spulica() As String, sppopr() As String, dlgulica As String, dlgpopr As String
    Dim poprrange As String, ucaseulica As String, ucasepopr As String, fulica2 As String, fpopr As String
    czas = Range("G65536").End(xlUp).Row
    poprrange = Range("C65536").End(xlUp).Row
    licznik = 2
    For Each ulica In Range("G2:G" & Range("G65536").End(xlUp).Row)
      ulica2 = Replace(ulica, " ", "")
      ulica2 = Replace(ulica2, "-GO", "")
      ulica2 = Replace(ulica2, "ą", "a")
      ulica2 = Replace(ulica2, "ć", "c")
      ulica2 = Replace(ulica2, "ę", "e")
      ulica2 = Replace(ulica2, "ł", "l")
      ulica2 = Replace(ulica2, "Ł", "L")
      ulica2 = Replace(ulica2, "ń", "n")
      ulica2 = Replace(ulica2, "ó", "o")
      ulica2 = Replace(ulica2, "ś", "s")
      ulica2 = Replace(ulica2, "Ś", "S")
      ulica2 = Replace(ulica2, "ż", "z")
      ulica2 = Replace(ulica2, "Ż", "Z")
      ulica2 = Replace(ulica2, "ź", "z")
      ulica2 = Replace(ulica2, "Ź", "Z")
      fulica2 = UCase(Mid(ulica2, 1, 1))
     
      For i = 2 To poprrange
        popr = Replace(Cells(i, 3), " ", "")
        popr = Replace(popr, "ą", "a")
        popr = Replace(popr, "ć", "c")
        popr = Replace(popr, "ę", "e")
        popr = Replace(popr, "ł", "l")
        popr = Replace(popr, "Ł", "L")
        popr = Replace(popr, "ń", "n")
        popr = Replace(popr, "ó", "o")
        popr = Replace(popr, "ś", "s")
        popr = Replace(popr, "Ś", "S")
        popr = Replace(popr, "ż", "z")
        popr = Replace(popr, "Ż", "Z")
        popr = Replace(popr, "ź", "z")
        popr = Replace(popr, "Ź", "Z")
        fpopr = UCase(Mid(popr, 1, 1))
          If fulica2 = fpopr Then
              For j = Cells(i, 2) To Cells(i + 1, 2) ' dla zakresu z B
                popr = Replace(Cells(j, 3), " ", "")
                popr = Replace(popr, "ą", "a")
                popr = Replace(popr, "ć", "c")
                popr = Replace(popr, "ę", "e")
                popr = Replace(popr, "ł", "l")
                popr = Replace(popr, "Ł", "L")
                popr = Replace(popr, "ń", "n")
                popr = Replace(popr, "ó", "o")
                popr = Replace(popr, "ś", "s")
                popr = Replace(popr, "Ś", "S")
                popr = Replace(popr, "ż", "z")
                popr = Replace(popr, "Ż", "Z")
                popr = Replace(popr, "ź", "z")
                popr = Replace(popr, "Ź", "Z")
                ucaseulica = Mid(UCase(ulica2), 1, Len(popr))
                ucasepopr = UCase(popr)
             
                  If ucaseulica = ucasepopr Then ' jezeli ulice sa takie same
                  Cells(licznik, 7) = Cells(j, 3)
                  Exit For
                  Else
                     Cells(licznik, 7) = StrConv(Cells(licznik, 7), vbProperCase)
                  End If
              Next
          Exit For
          End If
        Next
    licznik = licznik + 1

    'STATUS BAR
    Application.DisplayStatusBar = True
    With Application
    .ScreenUpdating = False
    .Cursor = xlWait
    .StatusBar = "Czekaj... - trwa obliczanie pola " & licznik & " z " & czas
    End With
    With Application
    .ScreenUpdating = True
    .Cursor = xlDefault
    .StatusBar = False
    End With
    ' END Status BAR

    Next
    End Sub

    Sprawdzenie

    Code:


    Private Sub sprawdzenie_Click()
    Dim kolumna As Integer
    Dim i As Long, j As Long, ulica As Range, popr As String, czas As String, fulica As String, fpopr As String, poprrange As String
    czas = Range("G65536").End(xlUp).Row
    poprrange = Range("C65536").End(xlUp).Row
    Range("H2:H65536").Value = ""
    licznik = 2
    For Each ulica In Range("G2:G" & Range("G65536").End(xlUp).Row) ' dla sprawdzanych ulic
    ulica2 = Replace(ulica, " ", "")
    ulica2 = Replace(ulica2, "-GO", "")
    ulica2 = Replace(ulica2, "ą", "a")
    ulica2 = Replace(ulica2, "ć", "c")
    ulica2 = Replace(ulica2, "ę", "e")
    ulica2 = Replace(ulica2, "ł", "l")
    ulica2 = Replace(ulica2, "Ł", "L")
    ulica2 = Replace(ulica2, "ń", "n")
    ulica2 = Replace(ulica2, "ó", "o")
    ulica2 = Replace(ulica2, "ś", "s")
    ulica2 = Replace(ulica2, "Ś", "S")
    ulica2 = Replace(ulica2, "ż", "z")
    ulica2 = Replace(ulica2, "Ż", "Z")
    ulica2 = Replace(ulica2, "ź", "z")
    ulica2 = Replace(ulica2, "Ź", "Z")
    fulica = UCase(Mid(ulica2, 1, 1))

        For i = 2 To poprrange ' dla poprawnych ulic
            popr = Replace(Cells(i, 3), " ", "")
            popr = Replace(popr, "ą", "a")
            popr = Replace(popr, "ć", "c")
            popr = Replace(popr, "ę", "e")
            popr = Replace(popr, "ł", "l")
            popr = Replace(popr, "Ł", "L")
            popr = Replace(popr, "ń", "n")
            popr = Replace(popr, "ó", "o")
            popr = Replace(popr, "ś", "s")
            popr = Replace(popr, "Ś", "S")
            popr = Replace(popr, "ż", "z")
            popr = Replace(popr, "Ż", "Z")
            popr = Replace(popr, "ź", "z")
            popr = Replace(popr, "Ź", "Z")
            fpopr = UCase(Mid(popr, 1, 1))
           
            If i = poprrange And fulica <> fpopr Then ' jeżeli koniec i nie znalazl zakresu
                Cells(licznik, 8) = "1" ' nie ma ulicy
            Exit For
            End If
            popr = Cells(i, 3)
            If fulica = fpopr Then ' jezeli znalazl zakres
                For j = Cells(i, 2) To Cells(i + 1, 2) ' dla zakresu z B
                popr = Cells(j, 3)
                    If popr = ulica Then
                    Cells(licznik, 8) = "" ' jest ulica
                    Exit For
                    Else
                    Cells(licznik, 8) = "1" ' nie ma ulicy
                    End If
                Next
            Exit For
            End If
        Next
    licznik = licznik + 1

    'STATUS BAR
    Application.DisplayStatusBar = True
    With Application
    .ScreenUpdating = False
    .Cursor = xlWait
    .StatusBar = "Czekaj... - trwa obliczanie pola " & licznik & " z " & czas
    End With
    With Application
    .ScreenUpdating = True
    .Cursor = xlDefault
    .StatusBar = False
    End With
    ' END Status BAR

    Next

    End Sub


    Wiem opasłe to ale działa no i to pierwszy mój kontakt z VBA. Jeszcze trzebaby pomyśleć nad upchaniem zmian ą->a ź->z w jakieś tablice

    ps. zmiana nazw w przypadku 20 000 ulic do poprawienia i 1 500 poprawnych zajmuje ok 10-15 minut więc znośnie bo poprzednio ponad godzinę :)

    Pozdrawiam