Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 75902 Skopiuj do schowka Autouzupełnianie z różnych arkuszy
Autor Wiadomość
maciejbilu 
Starszy Forumowicz


Wersja: Win Office 2021
Posty: 46
Wysłany: 06-06-2024, 12:45   Autouzupełnianie z różnych arkuszy

Witajcie,
Znaleziona w necie fajna formuła:
Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
'Sub "autocompletes" data entered into column A using a source table on a different worksheet. If more than one match is
'    found, the user is allowed to continue entering characters until a unique match is found. If no matches are found, the
'    data is accepted as entered. ALT + Enter, Enter to force the macro to accept data as entered. The sub is triggered by
'    the Enter key.
Dim cel As Range, match1 As Range, match2 As Range, rg As Range, targ As Range

    '***Please adjust the next two statements before using this code!***
Set targ = Intersect(Target, Range("A2:A30"))  'Watch the cells in column A
Set rg = Worksheets("Source data 1").Range("AutoCompleteText")    'Use named range AutoCompleteText for "autocomplete" info

If targ Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo errhandler    'If code encounters an error, turn events back on

For Each cel In targ
    If Not IsError(cel) Then
        If cel <> "" And Right(cel, 1) <> Chr(10) Then
            Set match1 = Nothing
            Set match1 = rg.Find(cel & "*", lookat:=xlPart, MatchCase:=False)  'Match is case insensitive
            If Not match1 Is Nothing Then
                Set match2 = rg.FindNext(after:=match1)
                If match2.Address = match1.Address Then     'Code is fooled by identical strings in two cells
                    cel = match1 'Only one match found. Use it to "autocomplete" the cell
                Else    'More than one match found. User must enter more data. Return to "Edit" mode
                    cel.Activate
                    Application.SendKeys ("{F2}")   'Begin editing after last character entered
                End If
            Else    'No matches found. Do not change entered text
            End If
        Else    'Strip the line feed from the end of the text string
            If cel <> "" And Right(cel, 1) = Chr(10) Then cel = Left(cel, Len(cel) - 1)
        End If
    End If
Next cel

errhandler: Application.EnableEvents = True
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


Działa idealnie ale potrzebuję dodać kolejne pole (zakres) w arkuszu gdzie autouzupełnianie będzie czerpało dane z innego zakresu.

W zał przykładowy plik.
Czyli Target pierwszy korzysta z pierwszego źródło, target drugi z drugiego.

Ktoś miałby pomysł jakby przepisać?

Pytanie dodatkowe:
A co zrobić jeżeli jedno ze źródeł np. to drugie znajduje się w innym pliku ( i oczywiście nie w tym samym katalogu)? Jaką składnię zastosować? Pytam bo próbowałem ze zwykłym odniesieniem
Workbooks("P:/xxx/xxx/xxx.xlsxm").Sheets("xxx").Range("xxxx")
i nie działa.

Dzięki

AutoComplete extended.xlsm
Pobierz Plik ściągnięto 8 raz(y) 24.38 KB

ID posta: 435747 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3469 razy
Posty: 10236
Wysłany: 06-06-2024, 13:40   

Można dodać sprawdzanie drugiego zakresu:
Kod:
If targ Is Nothing Then
    Set targ = Intersect(Target, Range("D2:D30"))  'Watch the cells in column D
    Set rg = Worksheets("Source data 2").Range("AutoText2")
End If
Nazwa zakresu "AutoText2" musi być wcześniej zdefiniowana.

Jeśli źródło ma być w innym pliku, należy go najpierw otworzyć. Najlepiej przypisać mu zmienną obiektową i później do tej zmiennej się odwoływać:
Kod:
Dim wkb As Workbook
Set wkb = Workbooks.Open("P:/xxx/xxx/xxx.xlsxm")
a później odwołanie
Kod:
wkb.Sheets("xxx").Range("xxxx")
Po otwarciu nowy skoroszyt jest aktywny, jeśli chcemy powrócić do skoroszytu głównego, to trzeba go ponownie wybrać lub aktywować.
Jak już nie będzie potrzebny, to:
Kod:
wkb.Close


AutoComplete extended.xlsm
Pobierz Plik ściągnięto 7 raz(y) 25.07 KB

ID posta: 435749 Skopiuj do schowka
 
 
maciejbilu 
Starszy Forumowicz


Wersja: Win Office 2021
Posty: 46
Wysłany: 06-06-2024, 14:09   

Elegancko,
Zaraz sprawdzę jak to działa ze ścieżką do pliku.

A co byś zaproponował jeżeli byłby jeszcze trzeci TARGET ?

AutoComplete extended(1).xlsm
Pobierz Plik ściągnięto 7 raz(y) 24.86 KB

ID posta: 435750 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3469 razy
Posty: 10236
Wysłany: 06-06-2024, 14:28   

Generalnie, to samo. Czyli dołożyć kolejne sprawdzenie.
Nie widzę danych do tego trzeciego celu.
ID posta: 435751 Skopiuj do schowka
 
 
maciejbilu 
Starszy Forumowicz


Wersja: Win Office 2021
Posty: 46
Wysłany: 06-06-2024, 20:07   

Dane do trzeciego targetu mogą być z drugiego źródła.
Dodając kolejnego If nie za bardzo chce współpracować. Znowu kłania się chyba znajomość składni.
ID posta: 435752 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3469 razy
Posty: 10236
Wysłany: 06-06-2024, 21:08   

Wydaje mi się, że działa. Sprawdź.

AutoComplete extended(1).xlsm
Pobierz Plik ściągnięto 6 raz(y) 25.02 KB

ID posta: 435755 Skopiuj do schowka
 
 
maciejbilu 
Starszy Forumowicz


Wersja: Win Office 2021
Posty: 46
Wysłany: 11-06-2024, 10:13   

Oczywiście, że działa!
Dzięki Ci bardzo.

Teraz tak.
VBA, świetnie działa na aplikacjach PC. Nie działa na aplikacjach smartfonowych.
Ponieważ plik nad którym pracuje będzie używany finalnie na smartfonie (O czym wcześniej nie wiedziałem), to VBA szlak trafia.

Czy ma ktoś jakieś doświadczenia jak można by to obejść? Inne rozwiązanie? Może jakaś nakładka w formie prostej aplikacji?

Dzięki

MB
ID posta: 435771 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.wip.pl

Archiwum

Strona uĹźywa plikĂłw cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przegl�darce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
SprawdĹş, w jaki sposĂłb przetwarzamy dane osobowe