Elektroda.pl
Elektroda.pl
X

Wyszukiwarki naszych partnerów

Kategoria: Kamery IP / Alarmy / Automatyka Bram
Montersi
Kategoria: Akumulatorki / Baterie / Ładowarki

Wyszukanie fragmentu tekstu w komórce - VBA

daro_p 27 Gru 2016 23:51
  • #1 27 Gru 2016 23:51
    daro_p
    Poziom 15  

    Witam. Proszę o pomoc w jednym temacie, mianowicie poszukuje rozwiązania problemu wyszukania zadanej frazy w tekście komórki Excela przez vba. Chodzi mi o algorytm, który sprawdzi tekst w komórce i na tej podstawie wpisze dane wyjściowe. Dla rozjaśnienia przykład. - użytkownicy przy wykonaniu danej czynności wpisują jej kod, np. "kod 8 obniżka ceny". Kodów jest 10, a ilość operacji zależna jest od ilości transakcji. I teraz sedno - kod szuka w komórce wyrażenia " kod 8", lub samo "8" - tu jest problem, gdyż użytkownicy różnie wpisują komentarze, i na tej podstawie, w komórce na prawo algorytm wpisuje "8". Jezeli we wpisanej frazie znajdzie "6" to wpisuje 6. Jezeli nie znajdzie dopasowania to wpisuje np "11". Pomysł jest taki, aby za pomocą tabeli przestawnej usystematyzować ilość użytych kodów, z podziałem na użytkowników. Problem, to pewna dobrowolność w opisie komentarza- pozostałe dane są systemowe, wiec stałe. Makro działa w pętli na podstawie kolumny A, aż dojdzie do pustej komórki. Nie wiem czy logicznie to przedstawiłem, jak nie, to doprecyzuję
    [/img]

  • #2 28 Gru 2016 00:41
    cbrman
    Poziom 26  

    Na szybko napisałem coś takiego. Przetestuj:

    Kod: vb
    Zaloguj się, aby zobaczyć kod

  • #3 28 Gru 2016 09:52
    daro_p
    Poziom 15  

    Dzięki wielkie za zainteresowanie - dzisiaj będę testował. Pominąłem chyba jedną ważną kwestie w moim wątku, a mianowicie "komentarze" do sprawdzenia przez algorytm są w kolumnie "h" (jest to mala baza danych) i jest to kolumna z formatowaniem "tekst". Pozostałe kolumny to juz dane liczbowe, muszą być pominięte w analizie.

  • #4 28 Gru 2016 15:10
    cbrman
    Poziom 26  

    To po prostu zmień przypisanie zakresu do obiektu rngTmp z kolumny A na kolumnę H. Wyszukane kody dopiszą się w kolumnie na prawo od kolumny zakresu przypisanego temu obiektowi.

  • #5 28 Gru 2016 16:03
    daro_p
    Poziom 15  

    Po drobnych modyfikacjach działa, lecz pojawił się problem innego rodzaju. Algorytm wyszukuje cyfrę, a nie ciąg znaków i w przypadku kiedy natrafi na opis " 1 szt kod 8" to przypisuje do "1" zamiast "8". Jeżeli jest komentarz "kod 10", to także przypisuje do "1" - na podstawie pierwszej cyfry. Chodzi mi właśnie o "wyłowienie" z tekstu komentarza zwrotu "kod X" ( x - od 1 do 10) i na tej podstawie przypisanie odpowiedniej wartości - właśnie na rozpoznaniu kodu mi zależy i nie udało mi się tego przeskoczyć. Nie wiem nawet, czy jest taka możliwość, aby VBA sobie z tym poradziło. Próbowałem przez formuły i udało mi się osiągnąć rozpoznawalność na poziomie około 60%, ale niestety plik robił się strasznie ciężki i powolny - dla przykładu jedna formułka
    =JEŻELI(JEŻELI.BŁĄD(ZNAJDŹ("kod10";LITERY.MAŁE(U2 );1);0)>0;1;JEŻELI(JEŻELI.BŁĄD(ZNAJDŹ("kod: 10";LITERY.MAŁE(U2 );1);0)>0;1;JEŻELI(JEŻELI.BŁĄD(ZNAJDŹ("kod:10";LITERY.MAŁE(U2 );1);0)>0;1;JEŻELI(JEŻELI.BŁĄD(ZNAJDŹ("kod-10";LITERY.MAŁE(U2 );1);0)>0;1;JEŻELI(JEŻELI.BŁĄD(ZNAJDŹ("kod- 10";LITERY.MAŁE(U2 );1);0)>0;1;JEŻELI(JEŻELI.BŁĄD(ZNAJDŹ("k.10";LITERY.MAŁE(U2 );1);0)>0;1;JEŻELI(JEŻELI.BŁĄD(ZNAJDŹ("k. 10";LITERY.MAŁE(U2 );1);0)>0;1;JEŻELI(JEŻELI.BŁĄD(ZNAJDŹ("kod 10";LITERY.MAŁE(U2 );1);0)>0;1;0))))))))

  • Pomocny post
    #6 29 Gru 2016 10:02
    cbrman
    Poziom 26  

    Skoro masz takie wariacje wpisów jak podałeś w formule (w sumie nie ma się co dziwić przy ręcznym wpisywaniu inwencja twórcza wpisujących nie zna granic), to spróbuj wyrażeń regularnych:

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    W kodzie zakomentowałem instrukcję warunkową dopisywania kodu nr 11 dla nieznalezionych kodów. Przy testach makra posprawdzaj sobie puste miejsca które ono zostawi (na pewno jakieś będą), bo pewnie trzeba będzie uzupełnić wzorzec wyrażeń regularnych.

  • #7 29 Gru 2016 20:21
    daro_p
    Poziom 15  

    Nie wiem jak, ale to działa!!!! Kody rozpoznaje prawie w 100% - nie wpisuje jednak kodu "11". Wszędzie gdzie nie występuje fraza "kod x" pozostawia puste miejsca. Pomija jeszcze opisy bez spacji np "kod10" - także zostawia puste miejsca.
    Jeżeli byłbyś tak miły i dopisał do wzorca zwrot "potrzeby" - aby przypisywał do niego kod "11", a wszystkie nierozpoznane i puste "12" to myślę że temat załatwiony w 100% i wieeeelkie piwo i szacuneczek za wiedzę się należy. Resztę załatwię tabelami przestawnymi.
    I w tym układzie jest to o niebo lepiej niż na moich formułach :-)
    Z góry dziękuję.

  • #8 02 Sty 2017 13:07
    cbrman
    Poziom 26  

    Kolejna wersja:
    - jeśli uda się rozpoznać kod zostanie on wpisany
    - jeśli nie rozpozna kodu wpisuje: 12
    - jeśli znajdzie słowo "potrzeby" wpisuje kod: 11
    Przetestuj:

    Kod: vb
    Zaloguj się, aby zobaczyć kod

  • #9 03 Sty 2017 17:49
    daro_p
    Poziom 15  

    Wkleiłem, trochę zmieniłem i jest kolejna poprawa. Musiałem zmienić kolejność instrukcji case, oraz dodać 1 do wzorca (bez tego pomijał kody od 1 do 9), rozpoznawał tylko "10". Na chwilę obecną nie rozpoznaje tylko pisowni dużych liter KOD 10, Kod 9 - i tu jest mały problemik, poza tym super. Teraz jest tak:

    Sub kody_RegEXP()

    Dim lLstRw&
    Dim i&
    Dim sCol$ 'kolumna z danymi

    sCol = "U"

    Range("Z2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

    With ActiveSheet
    lLstRw = .Cells(Rows.Count, sCol).End(xlUp).Row
    For i = 2 To lLstRw
    Cells(i, sCol).Offset(0, 5).Value = FindRegExp(Cells(i, sCol), "(k|kod)(\.|\:|\-|\s)*\d{1,2}|(potrzeby)|(wewnetrzna)")
    Select Case Cells(i, sCol).Offset(0, 5).Value
    Case Is = "potrzeby"
    Cells(i, sCol).Offset(0, 5).Value = 11

    Case Is = "wewnetrzna"
    Cells(i, sCol).Offset(0, 5).Value = 11
    Case Is = ""
    Cells(i, sCol).Offset(0, 5).Value = 12

    Case Else
    Cells(i, sCol).Offset(0, 5).Value = FindRegExp(Cells(i, sCol).Offset(0, 5), "\d{1,2}")
    End Select
    Next i
    End With

    Sheets("Wyniki").Select
    ActiveWorkbook.RefreshAll

    End Sub

  • Pomocny post
    #10 04 Sty 2017 08:15
    cbrman
    Poziom 26  

    Odnośnie rozpoznawania małych/dużych liter to w funkcji FindRegExp po linijce:

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    dodaj
    Kod: vb
    Zaloguj się, aby zobaczyć kod


    Przetestuj sobie czy drobna modyfikacja wzorca do wyszukiwania będzie u Ciebie działała:
    Kod: txt
    Zaloguj się, aby zobaczyć kod

  • #11 04 Sty 2017 15:42
    daro_p
    Poziom 15  

    Jest OK. Sporadycznie wpisze kod niżej (np 8 zamiast 9), ale szacuję rozpoznawalność na 98 - 99 %.
    Przy okazji nauczyłem się czegoś nowego z VBA i miałem okazję poszukać trochę w sieci na temat "wyrażeń regularnych" - choć przyznam, że jest tego mało.
    Temat możemy zamknąć.
    Jeszce raz wieeelkie dzięki i szacuneczek za poziom wiedzy :-)