Ustaw sobie autofiltr na tym zakresie danych, wypiesz "abc" i masz odfiltrowane wyniki. To najprościej.
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.
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.
Chodzi o to, by podczas np. edytowania bazy danych, dane wynikowe były uzupełniane na bieżąco.
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.
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 ;].
... gdyż naciskasz F9 idziesz zrobić kawę, wracasz i gotowe ...
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.
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.
Nie, nie jest taka sama struktura. Myślałem o makro, które "wprowadza" nową funkcję. Na zasadzie czegoś takiego:
Private Sub worksheet_selectionChange(ByVal Target As Range)
nrkom = ActiveCell.Address(False, False) 'adres aktywnej komorki
wier = ActiveCell.Row 'numer wiersza
kol = ActiveCell.Column 'numer kolumny
'wyswietlanie wynikow
Range("a1").Value = nrkom
Range("a2").Value = wier
Range("a3").Value = kol
End Sub
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ć.
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:
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".
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.
Set znaleziona = zakres1.Find(szukana, LookIn:=xlValues)
Jaką funkcje, inną od find [a może jest parametr find], wykorzystać by np wskazała 2 znalezioną itd.
tak jak jest zakres1.Find(xxx) można użyć zakres1.FindNext
To jednak też nie załatwia sprawy całkowicie, bo zaraz pojawią się następne problemy. Bardzo ładnie jest to opisane na stronie:
http://www.cpearson.com/Excel/FindAll.aspx (z rozwiązaniem)
marek003 wrote:
(niestety ja w vba za "mały" jestem)
Z tym zgodzić się absolutnie nie mogę !!
Pozdrawiam
I tu pytanie do ekspertów (niestety ja w vba za "mały" jestem)
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 ;].
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...
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?
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
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)
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...
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
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
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
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.
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
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
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.
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
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
. Nie daj się ograniczeniom i spójrz świeżym okiem 
.
), ale bardziej skomplikowanych rzeczy nie ogarniam.
Pamięć może się zjeżyć.
