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: 75331 Skopiuj do schowka Pobieranie danych
Autor Wiadomość
beret
ExcelGaduła 500+


Wersja: Win Office 365
Pomógł: 25 razy
Posty: 1275
Wysłany: 06-12-2023, 12:48   Pobieranie danych

W załączonym pliku wszystko fajnie działa jak Tabelka1 jest w Arkuszu1.
Jak zmienić poniższe makro, aby działało jeśli Tabelkę1 przeniosę do Arkusz2 w inne miejsce?

Kod:
Private Sub ListBox1_Click()
Range("B1").Value = Me.ListBox1
Range("D1").Value = Cells(Me.ListBox1.ListIndex + 2, "Q").Value
Range("D2").Value = Cells(Me.ListBox1.ListIndex + 2, "S").Value
End Sub


Listbox w arkuszu.xlsm
Pobierz Plik ściągnięto 22 raz(y) 22.46 KB

ID posta: 431908 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3397 razy
Posty: 10038
Wysłany: 06-12-2023, 14:49   

Trzeba odpowiednio zmienić definicję nazwy "nazwiska", wszystkie odwołania odpowiednio do nowego położenia tabeli. Teraz powinno działać.

Listbox w arkuszu1.xlsm
Pobierz Plik ściągnięto 24 raz(y) 23.57 KB

ID posta: 431923 Skopiuj do schowka
 
 
beret
ExcelGaduła 500+


Wersja: Win Office 365
Pomógł: 25 razy
Posty: 1275
Wysłany: 07-12-2023, 08:17   

Oczywiście działa.
A można inaczej, np. tak nadać nazwę całej tabelce i pobieranie odnieść od tej tabelki, a nie całego arkusza?
ID posta: 431944 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3397 razy
Posty: 10038
Wysłany: 07-12-2023, 17:38   

Można. Masz tu przykład dwóch sposobów odwołania do nazwanego zakresu w innym arkuszu. Ten pierwszy (zakomentowany) wymaga podania nazwy arkusza w kodzie.
Ten drugi (nieco dłuższy) odczytuje sobie nazwę arkusza z definicji nazwy zakresu.
Kod:
Private Sub ListBox1_Click()
   Range("B1").Value = Me.ListBox1
 '  Range("D1").Value = Arkusz2.Range("Tabelka1").Cells(Me.ListBox1.ListIndex + 2, 3).Value
   Range("D1").Value = ThisWorkbook.Names("Tabelka1").RefersToRange.Cells(Me.ListBox1.ListIndex + 2, 3).Value
 '  Range("D2").Value = Arkusz2.Range("Tabelka1").Cells(Me.ListBox1.ListIndex + 2, 5).Value
   Range("D2").Value = ThisWorkbook.Names("Tabelka1").RefersToRange.Cells(Me.ListBox1.ListIndex + 2, 5).Value
End Sub


Listbox w arkuszu2.xlsm
Pobierz Plik ściągnięto 11 raz(y) 23.72 KB

ID posta: 431985 Skopiuj do schowka
 
 
hurgadion 
ExcelSpec



Wersja: Win Office 2021
Pomógł: 1168 razy
Posty: 2675
Wysłany: 07-12-2023, 18:07   

Hej,
trochę inaczej jak Maciej Gonet, który zresztą naprowadził mnie na rozwiązanie. Za pomocą tego kodu, przy zmianie położenia tabeli i zmianie arkusza zmieniamy tylko adresy w menadżerze nazw, a w kodzie nic nie trzeba grzebać, o ile tabelka będzie taka sama... :lol: Kod ma postać:
Kod:

Private Sub ListBox1_Click()
Dim ark As String

Range("B1").Value = Me.ListBox1
ark = ThisWorkbook.Names("tabelka").RefersToRange.Worksheet.Name
Range("D1").Value = Worksheets(ark).Range("tabelka")(5 * Me.ListBox1.ListIndex + 8)
Range("D2").Value = Worksheets(ark).Range("tabelka")(5 * Me.ListBox1.ListIndex + 10)
End Sub

Pozdrawiam :lol:

Listbox w arkuszu2.xlsm
Pobierz Plik ściągnięto 10 raz(y) 23.37 KB

ID posta: 431988 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3397 razy
Posty: 10038
Wysłany: 07-12-2023, 18:21   

W mojej propozycji (w tej wersji niezakomentowanej) też nie trzeba niczego zmieniać w kodzie.
A gdy przenosimy nazwaną tabelkę w inne miejsce przez wytnij/wklej (nie: kopiuj/wklej/usuń starą), to nazwa też się przenosi wraz z tabelką w nowe miejsce.
ID posta: 431991 Skopiuj do schowka
 
 
Tajan


Pomógł: 5407 razy
Posty: 11795
Wysłany: 07-12-2023, 20:29   

Jeszcze inny sposób odwołania:
Kod:
Private Sub ListBox1_Click()
    Dim nrW As Long
   
    nrW = ListBox1.ListIndex + 2
   
    [d1] = [Tabelka1].Cells(nrW, 3).Value
    [d2] = [Tabelka1].Cells(nrW, 5).Value
End Sub

Nazwa "Tabelka1" powinna być zdefiniowana z widocznością "Skoroszyt".
ID posta: 431992 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3397 razy
Posty: 10038
Wysłany: 07-12-2023, 20:56   

Tajan, brawo za skrót :clap
ID posta: 431993 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