Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Pobieranie danych

beret · 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 59 raz(y) 22.46 KB

Maciej Gonet · 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 63 raz(y) 23.57 KB

beret · 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?

Maciej Gonet · 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 38 raz(y) 23.72 KB

hurgadion · 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 39 raz(y) 23.37 KB

Maciej Gonet · 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.

Tajan · **Pomógł:** 5548 razy Posty: 12042

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".

Maciej Gonet · Wysłany: 07-12-2023, 20:56

Tajan, brawo za skrót :clap