< návrat zpět

MS Excel

Téma: Vyhledání akt. řádku a vložení do jiné tabulky rss

Zaslal/a OB 15.6.2020 8:30

Dobrý den,
podle hodnoty v Listu1 v Comboboxu (ListFillRange=B:B - hodnoty dle sloupce Jméno (ale nabízí mi to i záhlaví sloupce JMÉNO :(), bych rád vyhledal hodnotu a podle té, vyjmul celý řádek do listu KOŠ na konec tabulky:

P.S. jde o to, že neumím pracovat s živými daty (tabuly v listu1 i "KOŠ" se pořád můžou zvětšovat, jak směrem dolů, tak do strany)

Předem děkuji za jakoukoliv pomoc....
VZOROVÝ SOUBOR přiložen.

Private Sub CommandButton2_Click()

'Vyhledání slova ze sloupce JMÉNO
Dim rng As Range
Range("A1:C70").Select

Set rng = Selection.Find(What:=ComboBox1.Text)

If Not rng Is Nothing Then
rng.Select

'Označení celého řádku, ve kterém je HLEDANÉ slovo ve sloupci Jméno
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select

'Vyjmutí celého řádku a vložení do listu "KOŠ"
Selection.Cut
Sheets("KOŠ").Select

'Určení prvního prázdného řádku v listu "KOŠ"
For prazdny = 2 To 65000
If Worksheets("KOŠ").Cells(prazdny, 1).Value = "" Then GoTo tu
Next prazdny
tu:
'Vložení dat do listu "KOŠ" do jednotlivých sloupců
'Worksheets("KOŠ").Cells(prazdny, 1) = Range(Selection, ActiveCell(1))
'Worksheets("KOŠ").Cells(prazdny, 2) = Range(Selection, ActiveCell(2))
'Worksheets("KOŠ").Cells(prazdny, 3) = Range(Selection, ActiveCell(3))
Selection.EntireRow.Insert

' Vymaže obsah ComboBox1
ComboBox1 = vbNullString
End If

End Sub

Příloha: rar46938_mb20200615_01.rar (23kB, staženo 20x)
Zaslat odpověď >
elninoslov(15.6.2020 12:50)#046939
elninoslov
Private Sub ComboBox1_GotFocus()
'Aktualizácia zoznamu ComboBox1
ComboBox1.ListFillRange = Range("ZOZNAM").Address(, , , True)
End Sub

Private Sub CommandButton2_Click()
'Vyhledání slova ze sloupce JMÉNO
Dim rng As Range, rngSource As Range, rngDest As Range, LOsource As ListObject

Set LOsource = ListObjects("Tabulka1")
Set rng = LOsource.ListColumns("jméno").DataBodyRange.Find(What:=ComboBox1.Text)

If Not rng Is Nothing Then
'Zdrojový riadok
Set rngSource = LOsource.Range.Rows(rng.Row)
'Cieľový riadok
Set rngDest = Worksheets("KOŠ").Cells(1, 1).End(xlDown)
'Zápis zdrojového riadku na cieľový s ošetrením posunu riadku, ak bola cieľová tabuľka iba s 1 riadkom
rngDest.Offset(IIf(IsEmpty(rngDest), 0, 1), 0).Resize(, rngSource.Columns.Count).Value = rngSource.Value
'Výmaz zdrojového riadku
rngSource.Delete Shift:=xlShiftUp
' Vymaže obsah ComboBox1
ComboBox1 = vbNullString

Set rng = Nothing: Set rngSource = Nothing: Set rngDest = Nothing: Set LOsource = Nothing
End If
End Sub
a Definovaný názov ZOZNAM
=OFFSET(Tabulka1[jméno];;;LOOKUP(2;1/(Tabulka1[jméno]<>"");ROW(Tabulka1[jméno])-1))
=POSUN(Tabulka1[jméno];;;VYHLEDAT(2;1/(Tabulka1[jméno]<>"");ŘÁDEK(Tabulka1[jméno])-1))
Příloha: zip46939_mb20200615_01.zip (24kB, staženo 16x)
citovat
OB(15.6.2020 23:12)#046943
avatar
SUPER!Ano děkuji. Takto to funguje. Ještě prosím o info, jak to udělat, aby se mi dynamicky přepsala informace:
Set LOsource = ListObjects("Tabulka1")

když budu kopírovat List1 a vytvořím List1(2) tak se mi tam ukáže tabulka pojmenovaná "Tabulka14".

Když budu znovu kopírovat ten samý List1 a vytvořím další List1 (3) tak je tam opět tabulka s jiným názvem, tentokrát "Tabulka15" a opět jak tento název dostat v rámci aktivního listu do:

Set LOsource = ListObjects("Tabulka15")?

Děkuji za radu.
Příloha: rar46943_mb20200615_02.rar (39kB, staženo 16x)
citovat
elninoslov(16.6.2020 13:12)#046948
elninoslov
Treba urobiť tieto veci:
1. Spoločné unifikované obslužné procedúry do normálneho modulu:
Sub CMD_Button_Click(ByRef cb As ComboBox) 'Vyhledání slova ze sloupce JMÉNO
Dim rng As Range, rngSource As Range, rngDest As Range, LOsource As ListObject

Set LOsource = cb.Parent.ListObjects(1) 'Načítanie 1. Tabuľky v liste, na ktorom je volacie tlačítko
Set rng = LOsource.ListColumns("jméno").DataBodyRange.Find(What:=cb.Text)

If Not rng Is Nothing Then
Set rngSource = LOsource.Range.Rows(rng.Row) 'Zdrojový riadok
Set rngDest = Worksheets("KOŠ").Cells(1, 1).End(xlDown) 'Cieľový riadok
rngDest.Offset(IIf(IsEmpty(rngDest), 0, 1), 0).Resize(, rngSource.Columns.Count).Value = rngSource.Value 'Zápis zdrojového riadku na cieľový s ošetrením posunu riadku, ak bola cieľová tabuľka iba s 1 riadkom
rngSource.Delete Shift:=xlShiftUp 'Výmaz zdrojového riadku
cb.Text = vbNullString 'Vymaže obsah ComboBox1

Set rng = Nothing: Set rngSource = Nothing: Set rngDest = Nothing: Set LOsource = Nothing
End If
End Sub

Sub CB_Refresh(ByRef cb As ComboBox) 'Znovuvyplnenie ComboBoxu pri jeho aktivácii
cb.ListFillRange = cb.Parent.Range("ZOZNAM").Address(, , , True)
End Sub

2. Samostatné definované názvy "ZOZNAM" pre List (!) nie pre Zošit.

3. V každom module listu:
Private Sub ComboBox1_GotFocus() 'Aktualizácia zoznamu ComboBox1 - Každý list má svoj definovaný názov ZOZNAM
CB_Refresh ComboBox1
End Sub

Private Sub CommandButton2_Click() 'Volanie spoločnej procedúry kliknutia
CMD_Button_Click ComboBox1
End Sub

Teda z toho vyplýva, že zmažete ZOZNAM pre Zošit. Vytvoríte rovnaký ZOZNAM ale pre jeden List. Do modulu toho listu dáte tie 2 volacie krátke procedúry. A nakoniec do normálneho modulu dáte tie 2 obslužné procedúry. Ak tento list potom duplikujete, automaticky bude fungovať, lebo si sám vytvorí vlastný ZOZNAM odkazujúci na jeho Tabuľku.

Predpoklady na fungovanie:
-listy si vytvorte nanovo z toho jedného upraveného
-objekty sa musia volať rovnako na každom liste
-daná Tabuľka musí byť ako prvá v liste (najlepšie jediná)
Příloha: zip46948_mb20200615_02.zip (36kB, staženo 18x)
citovat
OB(23.6.2020 21:46)#047023
avatar
elninoslov - Děkuji za pomoc. Vše funguje dle představ. 1citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje