Excel 2003 - wyszukanie tekstu i wypisanie danych

Question

Witam,najlepiej podam to przykładem:mamy taką tabelę: Quote: abc | 456xyz | 465xyz | 789mno | 267abc | 753abc | 542mno | 812abc | 945mno ...

marek003 · Accepted Answer

Zależy ci na konkretnych wartościach czy może być suma tych liczb? Bo jeżeli suma liczb to wykorzystaj funkcję Suma.jeżeli()

marek003 · Accepted Answer

Czy to cię zadowoli:(funkcja szuka wskazanego ciągu w "pełnym" ciągu)

marek003 · Accepted Answer

Właśnie z tego powodu proponuje ci funkcje excelowskie a nie makro.To co ci przedstawiłem to pomysł. Wzbij się ponad chmury i spójrz pod innym kątem . Nie daj się ograniczeniom i spójrz świeżym okiem . Bazy (ani dobrze przygotowanych kolumn pomocy) nie musisz edytować.Kolumna pomocnicza może być w każdym arkuszu (ukryta) ważne żeby formuły w tej kolumnie obejmowały wszystkie wiersze bazy czyli funkcje muszą być skopiowane minimum do ilości wierszy jakie są w bazie (może być więcej ale nie mniej) [Najlepiej skopiować do końca kolumny - choć to przesada - może do 1000]. To dotyczy również wyników bo jak wszystkie dane w bazie będą "ABC" to wynik ma pokazywać wszystkie a nie tylko 10 pierwszych.Mam nadzieje że ci się spodoba (tworząc nowy arkusz kopiujesz cały arkusz z już istniejącego i wpisujesz tylko inny ciąg). Pomoc wyniki są do 27 wierszy jeżeli w bazie jest więcej należy "złapać" komórki od A do E w wierszu 28 i przeciągnąć je dalej w dół. Sprawdzić czy w kolumnie C następuje dalsze numerowanie. Później skopiować cały arkusz do następnych arkuszy.Ale jeżeli się uprzesz (a wolno ci ) to pomyślimy i o makrze.

marek003 · Accepted Answer

A mogę zapytać po co naciskasz F9? Masz wyłączone automatyczne odświeżanie? Odwołania cykliczne w formułach?Owszem F9 wymusza przeliczanie ale całego arkusza/skoroszytu a akurat "moje" rozwiązanie tego nie potrzebuje (pod warunkiem że masz włączony standardowo automat w opcjach)W momencie zmiany poszukiwanego ciągu i naciśnięciu enter wyniki powinny ci sie od razu pokazać w tabeli obok. To samo przy wpisaniu nowej danej do bazy. (chodzi mi tylko o wyniki wyszukiwania ["moje" rozwiązanie])Jak znajdę czas to popróbuje na większej ilości danych.Po prostu obawiam się żę w tym przypadku makro nie przyśpieszy pracy całego arkusza bo wg mnie nie będzie szybsze od "mojego" rozwiązania opartego na funkcjach. W dodatku trzeba by zapytać czy to makro (po jednym uruchomieniu) miało by aktualizować wszystkie 30 arkuszy na raz?Zauważ że makro będzie musiało wykonać pętle w ilości równej 30.000 danych w bazie razy 30 arkuszy = 900.000 razy. Przy okazji sprawdzając warunki i wpisując poszczególne wartości do arkuszy. To też będzie trwało.Ale spróbować można.Tylko już teraz konkretne pytanie czy docelowy arkusz (struktura arkuszy i układ wierszy i kolumn) jest taki jak w przesłanym przez ciebie załączniku. Bo już w makro trzeba określać konkretnie miejsca docelowe.Dodane po ok.60 minutach-----------------------------------Przed chwila sprawdziłem i bijąc się w piersi potwierdzam że przy 40.099 danych w bazie zmiana poszukiwanego ciągu powoduje przeliczenie arkusza które trwa ok.4-5 minut (Sprzęt pentium dual-core 2.6GHz i 3 GB ramu)Tak się nie da pracować.Myślę że trzeba znaleźć inne rozwiązanie. Jak znajdę chwilę to spróbuje z makrem, ale czuje że będzie to samo przy tylu danych.

adamas_nt · Accepted Answer

Pozwoliłem sobie trochę przetestować

Moje wnioski:
Przeniesienie kolumny pomocniczej (rozwiązanie marek003) do ark "Baza danych" do kol D i korekta formuł w ark "ABC"

Code:

=JEŻELI(CZY.BŁĄD(INDEKS('Baza danych'!A:A;PODAJ.POZYCJĘ($B2;'Baza danych'!$D:$D;0);1));"";INDEKS('Baza danych'!A:A;PODAJ.POZYCJĘ($B2;'Baza danych'!$D:$D;0);1))

już zauważalnie przyśpieszyło przeliczanie. Idąc tym tropem można rozważyć umieszczenie wyników wszystkich możliwych wyszukiwań (ABC, XYZ, itd) w jednym arkuszu roboczym, a w wynikowym odwoływać się tylko do adresów (właściwych kolumn).
Strasznie długo trwałoby tylko przeliczenie w momencie umieszczania danych i ewentualnie korekty szukanych ciągów w bazie. Sama zmiana w arkuszu wynikowym... pstryk i (po chwili) gotowe.

Przetestowałem też pętle i typy zmiennych. Najszybciej działa Do While ze zmiennymi typu Long. I tu następny pomysł. Połączyć sposób opisany wyżej (ADR.POŚR) z makrem tworzącym tablice. Jeśli szukana jest, wtedy funkcje wyświetlają wynik. Jeśli nie ma, rusza makro i tworzy następną tablicę (przy ok 10000 wierszy trwa to na moim sprzęcie ~60sek). Tu przy otwarciu pliku można wyłączyć przeliczanie i włączyć dopiero na końcu makra po pozytywnym wyniku testu (tablica istnieje) lub stworzeniu tablicy oraz przy zamknięciu pliku...

adamas_nt · Accepted Answer

Jeśli FindNext w pętli, to na tym samym zakresie (zakres1, zakres2). Z drugiej strony

Code:

Sub Wywolaj()

MsgBox "Wynik: " & Szukaj("ABC", "A:A", "B:B", 5)

End Sub



Function Szukaj(szukana As String, zakres1 As String, zakres2 As String, Optional numer As Integer)

Set zak1 = Range(zakres1)

Set zak2 = Range(zakres2)



Set znaleziona = zak1.Find(szukana, LookIn:=xlValues)



For x = 2 To numer

    Set znaleziona = zak1.FindNext(znaleziona)

    MsgBox znaleziona.Row

Next x



Szukaj = zak2.Rows(znaleziona.Row)



End Function

P.S. Pamiętaj o zresetowaniu zmiennych obiektowych

Pamięć może się zjeżyć.
Ciekawa jest pomoc Excela na temat metody FindNext...

adamas_nt · Accepted Answer

Chodzi o to, że FindNext w tej postaci przeszukuje ten sam zakres za każdym razem. Czyli, zdaje się, znajduje to samo i zwraca Nothing. Nie za bardzo mogę złapać dlaczego działa pod przyciskiem, może kiedyś przy innej okazji do tego dojdziemy...

Wracając do tematu: Zmodyfikowałem nieco (tu przynajmniej rozumiem co się dzieje) i teraz wygląda OK

Code:

Function Szukaj(szukana As String, zakres1 As Range, zakres2 As Range, Optional numer As Integer)



Set znaleziona = zakres1.Find(what:=szukana)



For x = 2 To numer

    Set znaleziona = zakres1.Find(what:=szukana, after:=znaleziona)

Next x



Szukaj = zakres2.Rows(znaleziona.Row)



Set znaleziona = Nothing 'to tu

End Function

adamas_nt · Accepted Answer

Świetna robota! A jeśli jeszcze wyłączyć odświeżanie...

Code:

Sub Szukaj_wszystkie()

Start = Timer

Application.ScreenUpdating = False

Columns("H:H").ClearContents

szukana = Range("e1")

Set znaleziona = Range("a:a").Find(what:=szukana)



If Not znaleziona Is Nothing Then

    wiersz1 = znaleziona.Row

    Cells(2, 8) = Range("b:b").Rows(wiersz1)

    wierszx = 0

    x = 2



    Do While wiersz1 <> wierszx

        Set znaleziona = Range("a:a").Find(what:=szukana, after:=znaleziona)

        wierszx = znaleziona.Row

    

        If wiersz1 <> wierszx Then

            x = x + 1

            Cells(x, 8) = Range("b:b").Rows(wierszx)

        Else

            Exit Do

        End If

    Loop

    

Else

    MsgBox "Brak szukanego ciągu"

End If



Set znaleziona = Nothing

meta = Timer

Application.ScreenUpdating = True

MsgBox "Zrobione w " & Round(meta - Start, 2) & " sek."

End Sub

yogi009 · Answer

Ustaw sobie autofiltr na tym zakresie danych, wypiesz "abc" i masz odfiltrowane wyniki. To najprościej.

kooowal · Answer

Tak nie przejdzie, gdyż przykładowe "abc" to fragment tekstu i nie znajdzie wszystkiego. Natomiast funkcję chcę użyć w wielu innych arkuszach korzystając z jednej bazy danych.

kooowal · Answer

Chodzi o konkretne wartości, gdyż są to numery zleceń/faktur.

kooowal · Answer

Ciekawy pomysł, tylko problem w tym, że musiałbym edytować bazę danych za każdym razem - co pomaga mi tyle samo co autofiltr, czyli mimo wszystko ręczna robota za każdym razem. Nie ma to zastosowania w przypadku, gdy w pierwszym arkuszu jest baza danych a w pozostałych kilku arkuszach szukane dane zależne od szukane fragmentu tekstu.Może nie do końca wytłumaczyłem o co dokładnie chodzi, więc załączam plik jak mniej więcej to wyglądać powinno.Pierwszy arkusz to baza danych a reszta arkuszy to poszczególne wyniki szukania (oczywiście oryginalnie tych arkuszy jest więcej - ok. 30).Chodzi o to, by podczas np. edytowania bazy danych, dane wynikowe były uzupełniane na bieżąco.

kooowal · Answer

Powiem Ci, że mnie zaskoczyłeś, jakoś nie wpadłbym na to, że można to w ten sposób zrobić. Spróbuję to wrzucić do oryginału - lecz nie gwarantuję, że się uda. Tam już jest tyle funkcji na każdym kroku, że łatwo się zgubić ;]. Po za tym, każdy arkusz będzie trzeba ręcznie przerabiać, właśnie ze względu na te funkcje wszystkie już tam wprowadzone. Mam nadzieję, że czegoś nie poplącze.

Jak się uda, będzie trzeba przerobić 4 bazy w każdym po ~30 arkuszy i ~30tys danych w bazie - co zajmie wieki

.

Jeżeli polegnę, na pewno jeszcze się zwrócę z tym problemem ;].

EDIT: Pierwsze próby zakończyły się fiaskiem. Przy takiej ilości danych już w pierwszym arkuszu excel bardzo długo myśli, a co dopiero będzie przy 30 arkuszach. Makro na pewno byłoby lżejsze, gdyż naciskasz F9 idziesz zrobić kawę, wracasz i gotowe

. Dodać muszę, iż komputery w pracy nie są pierwszej jakości ;].

yogi009 · Answer

I dlatego wymyślono funkcję kopiuj-wklej

kooowal · Answer

Wiem, że to jest dość proste makro, ale jego użycie jest banalnie proste jako funkcja kolor.Jest możliwość zrobienia czegoś takiego do mojego przypadku? Baza danych, z której by pobierał dane jest w tym samym miejscu (zawsze jest to arkusz: "ZZ Trasy"). Szukany ciąg znaków powinien szukać w kolumnie E natomiast dane, które powinien pobierać jako wyniki są w kolumnie A - dwa pierwsze wiersze nie powinny być brane pod uwagę, są to nazwy kolumn itp.).Nazwa funkcji np. Szukaj.I przykładowo wpisujesz w danej kolumnie "=Szukaj(abc)" i od bieżącej kolumny w dół wypisuje znalezione dane/wyniki.Nie jestem fachowcem, więc nie wiem czy da się coś takiego zrobić.

marek003 · Answer

Przedstawiona funkcja jest prosta, tyczy się jednej komórki i właściwie nic nie robi. Nie szuka, nie wybiera, to tak jak "=" (równa się) tylko nie wartość komórki a przypisany do wskazanej komórki numer indeksu.
na marginesie funkcja kolor to tylko tyle kodu:

Code:

Function Kolor(Adres As Range) 



Application.Volatile True 

Kolor = Adres.Interior.ColorIndex 



End Function

Zauważ że byłoby prościej gdybyś chciał tylko jeden wynik (Funkcje wpisujesz w jednej komórce).
Ale ty chcesz parę wyników (jak nie wszystkie) w różnych komórkach i w dodatku za każdym razem inne/kolejne.
Więc przed pisaniem funkcji trzeba się zastanowić czy chcesz pierwszy znaleziony wynik w wyniku czy dodatkowo będziesz podawał liczbę określającą który wynik cię satysfakcjonuje.
(Sam excel nie wstawi za ciebie formuł jak i nie będzie wiedział wcześniej ile jest wyników z danym ciągiem)

Spróbuje pomyśleć nad tą funkcją ale jednocześnie jestem otwarty na sugestie innych kolegów z forum. Bo wbrew pozorom ta funkcja nie będzie taka prosta jak "kolor".

marek003 · Answer

Stworzyłem coś takiego (właściwie to prawie to samo co funkcja wyszukaj.pionowo() ):

Code:

Function Szukaj(szukana As String, zakres1 As Range, zakres2 As Range)



Set znaleziona = zakres1.Find(szukana, LookIn:=xlValues)



wiersz = znaleziona.Row



Szukaj = zakres2.Rows(wiersz)



End Function

Szukaj(ciąg szukany; kolumna przeszukiwana; kolumna z wynikami)
Obie klolumny powinny mieć ten sam wymiar.

Funkcja znajduje pierwszy wynik.

Niestety na chwilę obecną zabrakło mi pomysłów. I tu pytanie do ekspertów (niestety ja w vba za "mały" jestem)

Jaką funkcje, inną od find [a może jest parametr find], wykorzystać by np wskazała 2 znalezioną itd.

Aldrin · Answer

Z tym zgodzić się absolutnie nie mogę !!Pozdrawiam

kooowal · Answer

To w takim razie ja nie istnieje, skoro Ty w tym temacie mały jesteś . Ja to naprawdę zielony jestem, podstawy znam jak najbardziej (excel a nie vba ), ale bardziej skomplikowanych rzeczy nie ogarniam.Ale widzę, że coś się kręci. Naprawdę byłbym wdzięczny jakby się udało . Ciężko dzisiaj o pomoc w róznych sprawach, ale widzę dobrze trafiłem ;].

marek003 · Answer

Czepiłem się tego od rana i dalej nie mogę rozgryźć tej zagadki.
Dlaczego w makro działa FindNext a w funkcji nie chce załapać? Gdzie robię błąd?

Dodałem do funkcji opcję by wskazać który nr wyniku ma wyświetlać (na razie nie myślałem nad zabezpieczeniami gdy nie ma ciągu)

Wszystko jest dobrze jak się nie poda numeru wyniku lub poda się 1 bo pierwszą znajduje. Ale jak się poda więcej niż 1 np 5 to procedura wchodzi w pętle FOR i ...
już za pierwszym przejściem ustawia wartość "znaleziona" na "nothing"

Coś jest chybe nie tak z określeniem zakresu (zakres1) w przypadku wejścia do pętli ale nie mam pojęcia co. Może źle deklaruje zmienną? no niewiem?

W "normalnym makro" działa tak jak powinno a w funkcji nie chce. Może ktoś pomóc?

Tu procedura:

Code:

Sub Szukaj_pokaz_jeden()





szukana = Range("d2")

Set zak1 = Range("a:a")

Set zak2 = Range("b:b")

numer = Range("e2")





Set znaleziona = zak1.Find(szukana, LookIn:=xlValues)

    

For x = 2 To numer

    Set znaleziona = zak1.FindNext(znaleziona)

Next x

   

Range("g6") = zak2.Rows(znaleziona.Row)



    

End Sub

Tu funkcja:

Code:

Function Szukaj(szukana As String, zakres1 As Range, zakres2 As Range, Optional numer As Integer)



Set znaleziona = zakres1.Find(szukana, LookIn:=xlValues)



For x = 2 To numer

    Set znaleziona = zakres1.FindNext(znaleziona)

Next x



Szukaj = zakres2.Rows(znaleziona.Row)



End Function

Przykład w załączniku (jest ok 40 tys danych) (więc spakowałem)

Attachments:

Szukaj.zip Download (427.85 KB)

marek003 · Answer

Rzeczywiście pomieszałem zakresy - ale to przy "wprowadzaniu" do elektrody - chciałem jakoś ładnie nazwać zmienne i wkradł się błąd.

Za chwilkę poprawie wcześniejszy post

Niemniej to nie zmienia problemu.
Twojej wersji funkcji szukaj też nie da się wywołać "z arkusza" (tak jak zwykłej funkcji excelowskiej a nie przez uruchom makro) Chyba że ja coś źle definiuje.

Ps
Przyznam że o resetowaniu zmiennych obiektowych wogóle nie pomyślałem ale zauważyłem kłopoty z szybkością działania kompa.
W związku z tym czy

Code:

set zak1=""

można traktować jak reset? Czy do tego stosuje się coś innego?.

A propo pomocy FindNext jakoś nie moge jej zrozumieć (może dlatego że nie znam angielskiego

)

marek003 · Answer

Teraz funkcja działa jak powinna

Człowiek uczy się cały czas

Dzięki za wyjaśnienia.

Jednak sprawdziłem na 40 tys. danych (40 tys. formuł wpisanych jedna pod drugą z kolejnym numerem znajdowanego wyniku) i ... to rozwiązanie nie zadowoli autora bo... przelicza jeszcze dłużej niż w mojej pierwszej wersji bez makra. (od 15 min mam dla excela 97% mocy procesora i jeszcze nie doszedł do końca przeliczeń) [Musiałem użyć "trzech króli" aby to zakończyć).
I jak się teraz zastanowić to nic dziwnego bo każda funkcja wpisana w komórce to pętla powiększana o 1 czyli np wynik z 10.000 pozycji to 10 tys obrotów pętli a pod nią jest kolejna funkcja z pozycją 10.001 czyli 10.001 obrotów pętli.
W tym przypadku to trwa w "nieskończoność".

Zapewne funkcja przyda się do innych celów ale nie do tego co chce autor.
Pozostaje tu "zwykłe" makro pod przyciskiem wykazujące w kolejnych komórkach kolejne wyniki (nie automatycznie ale po kliknięciu w przycisk)
Ewentualnie jakaś inna opcja -ograniczająca dane i wyniki. Inaczej tego nie widzę.

Poniżej poprawne makro (pod przycisk) z trafnymi sugestiami kolegi adamasa_nt.
Na 40tys danych przy ciągu abc czas wykonania ok 4 sek.

Code:

Sub Szukaj_wszystkie()



Columns("H:H").ClearContents



szukana = Range("e1")



Set znaleziona = Range("a:a").Find(what:=szukana)

If Not znaleziona Is Nothing Then

    wiersz1 = znaleziona.Row

    Cells(2, 8) = Range("b:b").Rows(wiersz1)



    wierszx = 0

    x = 2



    Do While wiersz1 <> wierszx

        Set znaleziona = Range("a:a").Find(what:=szukana, after:=znaleziona)

        wierszx = znaleziona.Row

    

        If wiersz1 <> wierszx Then

            x = x + 1

            Cells(x, 8) = Range("b:b").Rows(wierszx)

        Else

            Exit Do

        End If

    Loop

    

Else

       MsgBox "Brak szukanego ciągu"



End If



Set znaleziona = Nothing





End Sub

Poniżej w excelu

kooowal · Answer

wow

Patrze mistrzowie tutaj normalnie, sprawdzę to dzisiaj popołudniu. Piękna robota. Dam znać jak to wygląda

EDIT: Chociaż nie rozumiem o co tutaj chodzi z tym przyciskiem, ale jak sprawdzę to pewnie się zorientuję.

EDIT 2: Co do makro tworzącego funkcję "prostą" wiedziałem jak użyć, tak tutaj nie mam zielonego pojęcia z której strony to ugryźć.

EDIT 3: OK, ogarnąłem temat

. Wszystko fajnie, ale mam jeszcze jeden mały problem. Jest ok, dopóki sprawdzam w tym samym arkuszu. Ale co jeżeli chcę odwołać szukany zakres do innego arkusza.
Tzn. W arkuszu, w którym umieszczam "przycisk" będą wyniki, natomiast dane, które powinien przeszukiwać są w inny arkuszu.
Można w tym module użyć coś takiego?

Quote:
Set znaleziona = Range("Arkusz1!a:a").Find(what:=szukana)

EDIT 4: Ok, już wiem że można ;]. Ale wyszedł jeszcze jeden problemik. Miejsce wypisywania wyników. Tutaj wypisuje w danej kolumnie od samego początku. A chciałbym, żeby wyniki były wypisywane np. od komórki H5 w dól.

adamas_nt · Answer

Można.Code: Sub Szukaj_wszystkie() 'Start = Timer Application.ScreenUpdating = False szukana = Range("e1") x = 5 'od którego wiersza Set ark = Sheets("Arkusz1") 'do którego arkusza ark.Range("H" & x & ":H" & ark.Range("H65536").End(xlUp).Row).ClearContents Set znaleziona = Range("a:a").Find(what:=szukana) If Not znaleziona Is Nothing Then wiersz1 = znaleziona.Row ark.Cells(x, 8) = Range("b:b").Rows(wiersz1) wierszx = 0 Do While wiersz1 <> wierszx Set znaleziona = Range("a:a").Find(what:=szukana, after:=znaleziona) wierszx = znaleziona.Row If wiersz1 <> wierszx Then x = x + 1 ark.Cells(x, 8) = Range("b:b").Rows(wierszx) Else Exit Do End If Loop Else MsgBox "Brak szukanego ciągu" End If Set znaleziona = Nothing Set ark = Nothing 'meta = Timer Application.ScreenUpdating = True 'MsgBox "Zrobione w " & Round(meta - Start, 2) & " sek." End Sub

kooowal · Answer

Przez chwilę miałem problem z tą poprawką, ale po paru próbach i błędach się udało.
Jestem naprawdę pod wrażeniem, myślałem że to będzie trochę łatwiejsze. Chciałem sam z tym walczyć, ale dobrze że się z tym zwróciłem tutaj. Może by mi się udało to ogarnąć, ale w przeciągu roku lub jeszcze dłużej

.

Jeszcze raz pięknie dziękuję. Problem rozwiązany

. Nawet nie wiecie jak bardzo mi to ułatwi pracę. Pozdrawiam serdecznie, Kowal :!: