Čakáme na príklad ....
Ja si myslím, že ide o získanie odkazu (ako text) pod User-Friendly textom, bez následného načítavania údajov z odkazovaných zdrojov.
Jedine cez VBA.
Prípadne
=B1-(B1>=0)*A1
EDIT:
Alebo to nerobte zasahovaním do vzorcového stĺpca, ale urobte si nejaké zaškrtávacie políčka, napr. v prílohe.
A nie sú tie "čísla" v zdrojovej tabuľke náhodou text? Skúste iba vo vzorci previesť "číslo" na číslo napr vynásobením 1*
...1*SVYHLEDAT(...
Môžete uviesť jeden taký súbor?
Všetky sú v tom istom adresári?
Môže to byť PowerQuery (PQ) dotaz do zjednocujúcej Tabuľky? (ak máte verziu Office 2010, 2013, 2016 treba doinštalovať ofiko doplnok PQ, ak verziu 2019, 2021, 365 tak ten už to obsahuje)
Všetky majú rovnakú štruktúru, predpokladám.
Dáta po naimportovaní chcete ďalej ešte editovať, alebo len analyzovať?
Potrebujete skutočne použiť Copy+Paste? Potrebujete aj vyfarbenie, orámovanie a pod? Nestačili by Vám iba hodnoty v bunkách? V 99,9% prípadov je to tak. Potom by bolo získanie hodnôt rýchlejšie či už makrom alebo s PowerQuery.
Príklad.
A ako pätu si dajte tie Vaše údaje ako obrázok.
Maticový Ctrl+Shift+Enter od Office 2019 je funkcia TEXTJOIN:
=IF(COUNTIF($B$2:$B$10;B2)=1;"";TEXTJOIN(", ";TRUE;IF(($B$2:$B$10=B2)*($A$2:$A$10<>A2);$A$2:$A$10;"")))
=KDYŽ(COUNTIF($B$2:$B$10;B2)=1;"";TEXTJOIN(", ";PRAVDA;KDYŽ(($B$2:$B$10=B2)*($A$2:$A$10<>A2);$A$2:$A$10;"")))
Hľadanie pomocou Collection bude veľmi rýchle. Ale ako chcete používať akékoľvek hľadanie kódu a ID, ak je to plné dupiel (pod jedným kódom sú rôzne ID) ?
Sub CollectionLookup()
Dim Data(), ID(), Kod(), Col As New Collection, i As Long, RowsData As Long, RowsExport As Long
RowsExport = wsEXPORT.Cells(Rows.Count, "D").End(xlUp).Row - 1
If RowsExport = 0 Then MsgBox "Chýbajú kódy v EXPORT.", vbExclamation: Exit Sub
If RowsExport = 1 Then ReDim Kod(1 To 1, 1 To 1): Kod(1, 1) = wsEXPORT.Range("D2").Value2 Else Kod = wsEXPORT.Range("D2").Resize(RowsExport).Value2
ReDim ID(1 To RowsExport, 1 To 1)
RowsData = wsData.Cells(Rows.Count, "A").End(xlUp).Row - 1
If RowsData = 0 Then MsgBox "Chýbajú data.", vbExclamation: GoTo KONIEC
Data = wsData.Range("A2:B2").Resize(RowsData).Value2
On Error Resume Next
For i = 1 To RowsData
Col.Add Data(i, 2), CStr(Data(i, 1))
Next i
For i = 1 To RowsExport
ID(i, 1) = Col(CStr(Kod(i, 1)))
Next i
On Error GoTo 0
KONIEC:
wsEXPORT.Range("A2").Resize(RowsExport).Value2 = ID
Set Col = Nothing
End Sub
Ja by som obmedzil početnosť výpisu na nejaké "skoky". Inak sa totiž ľahko stane, že bude makro rýchlejšie ako je schopné sa prekresľovať okno či prvok.
Odkaz je platný, ale do mojej schránky SZ
To som páchal ja. Ktorý to je topic, nech si pohľadám celý súbor ? Alebo mi pošlite aktuálny súbor.
Nič nesľubujem, musí to byť na desiatky minút, inak končím. Som dlhodobo chorý...
Ak je to 2 rozmerné pole, potrebujete Transpose (v tomto prípade bez premennej - podľa potreby prípadného ďalšieho spracovania...).
Sheets(Application.Transpose(Sheets("List1").Range("A1:A3"))).Copy
Ak je množstvo listov dynamické, teda môže nastať 1, tak to do poľa neprejde. To treba ošetriť. Ak môže nastať, že bude medzi bunkami prázdna, či neexistujúci list, to treba ošetriť...
Funkčné makro - zdroj.
Za výkonným riadkom dajte
DoEvents
Ale pozor ! Veľmi to spomaľuje !
Ak je príloha XLSM, musí byť zabalená v ZIP.
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.