Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Autouzupełnianie z różnych arkuszy

maciejbilu · Starszy Forumowicz Wersja: Win Office 2021 Posty: 46

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 29 raz(y) 24.38 KB

Maciej Gonet · Wysłany: 06-06-2024, 12: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 30 raz(y) 25.07 KB

maciejbilu · Starszy Forumowicz Wersja: Win Office 2021 Posty: 46

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 33 raz(y) 24.86 KB

Maciej Gonet · Wysłany: 06-06-2024, 13:28

Generalnie, to samo. Czyli dołożyć kolejne sprawdzenie.
Nie widzę danych do tego trzeciego celu.

maciejbilu · Starszy Forumowicz Wersja: Win Office 2021 Posty: 46

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.

Maciej Gonet · Wysłany: 06-06-2024, 20:08

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

AutoComplete extended(1).xlsm

Pobierz Plik ściągnięto 30 raz(y) 25.02 KB

maciejbilu · Starszy Forumowicz Wersja: Win Office 2021 Posty: 46

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