< návrat zpět

MS Excel


Téma: Vyhledání a doplnění textu ve dvou souborech rss

Zaslal/a 26.6.2013 8:46

Zdravím
potřeboval bych vyřešit univerzální problém s vyhledáním textu v jednom souboru a doplnění do druhého.
Jako přiklad jsem si z netu stáhl tabulku z nějakými názvy instituci (berte to tedy jako příklad-nikoliv jako pravdivou informaci).
Jde mi o to - v souboru profes_org.xls prohledat sloupec, na kterem bude kurzor (v tomto případě A), a porovnat nalezený text se sloupcem A souboru zkratky.xls. Pokud bude nalezený text přesně souhlasit (neberou se v potaz malá/VELKÁ písmena) pak se do sloupce D doplní zkratka ze sloupce B (zkratky.xls).
Cesta k souborům aby byla v makru editovatelná (proměnná).
Díky 1

Příloha: zip14127_zkratka.zip (12kB, staženo 23x)
Zaslat odpověď >

Strana:  « předchozí  1 2 3
icon #014177
eLCHa
Nechtěl jsem se do toho plést, ale ve chvíli, kdy tady vidím něco o doplňcích, tak musím.

ŠMANKOTE

Cestu jsem nastínil výše, stačí dát to do kódu

Sub Makro1()
Dim sSourcePath As String, sSourceFileSheet As String, sSource As String
sSourcePath = ThisWorkbook.Path
sSourceFileSheet = "[zkratky.xls]seznam prof.org."
sSource = sSourcePath & "\" & sSourceFileSheet

Dim sFormula As String
sFormula = "=INDEX('" & sSource & "'!C2,MATCH(RC[-3],'" & sSource & "'!C1" & ",0))"

With Range("D2:D27")
.FormulaR1C1 = sFormula
.Value = .Value
.Replace What:="#N/A", Replacement:="nenalezeno", LookAt:=xlWhole

Range("A2:A27").Value = .Value
.ClearContents
End With 'Range("D2:D27")
End Sub

kód v této podobě funguje pro soubory umístěné ve stejné složce - je možno upravit
soubor zkratky není třeba otevírat

edit: název proměnných v definici Dimcitovat
icon #014182
avatar
@eLCHa, @GeorgeK
Bohužel nemám možnost (práva) instalovat doplňky a řádek
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;...." hází chybu
3706 - Zprostředkovatel nebyl nalezen.

V tomto prípade sa pmn nejedná o doplnok ale o referenciu na knižnicu, tá sa nastavuje vo VBE, eventuálne sa dá nastaviť programovo (priamo v procedúre), či použiť late binding, pletiem sa?citovat
icon #014187
eLCHa
@AL
Já jsem ten kód od Palooo nezkoumal, takže nevím jak to má udělané, jen když jsem viděl, že se baví o doplňcích, taxem musel zareagovat, protože mi to přišlo zbytečné.
Opravdu to vypadá na referenci, i když já ji ve svém PC také nevidím (takže zřejmě proto ta instalace)

@GeorgeK
Když už se tu na to narazilo: Pro instalaci doplňků do excelu dle mého názoru není třeba oprávnění - je možné, že nemáte oprávnění na složku, do které chce excel doplněk instalovat (u mne to tak je, ale co chcete po lidech, kteří instalují počítače ve firmě) - dá se to obejít tak, že si ho uložíte někam jinam a načítat ho budete z tohoto místa. To jen tak na okrajcitovat
icon #014188
eLCHa
A ještě drobná oprava, která mne napadla až dnes
Můj kód totiž mění nastavení Dialogu nahradit a to mi vadí (kód po proběhnutí by měl zanechat excel v takovém stavu, v jakém byl na jeho začátku - pokud možno)
Takže v tomto případě by šlo využít tento trik
místo

.Replace What:="#N/A", Replacement:="nenalezeno", LookAt:=xlWhole
toto
.SpecialCells(xlCellTypeConstants, xlErrors).Value = "nenalezeno"citovat
#014189
avatar
Díky všem za náměty a řešení.
Nakonec jsem to upravil takto:

Sub test()
Dim oWB As Workbook
Dim aWB as String
aWB = ThisWorkbook.Name
Set oWB = app.Workbooks.Open("C:\Data\test\zkratky.xls")
Workbooks(aWB).Activate
For x = ActiveCell.CurrentRegion.Rows(1).Row + 1 To ActiveCell.CurrentRegion.Rows(ActiveCell.CurrentRegion.Rows.Count).Row
For y = 2 To oWB.Sheets(1).Cells(1, 1).CurrentRegion.Rows.Count
If LCase(oWB.Sheets(1).Cells(y, 1)) = LCase(Cells(x, ActiveCell.Column)) Then
ActiveSheet.Cells(x, ActiveCell.Column) = oWB.Sheets(1).Cells(y, 2)
End If
Next
Next

oWB.Close
Set oWB = Nothing
End Sub


Přepisuje zkratkou ten sloupec, na kterém je kurzor. Je to univerzálnější a funguje 1citovat
icon #014190
eLCHa
@GeorgeK
Pokud vám nevadí, že je soubor zkratky otevřen - z nějakého příspěvku jsem pochopil, že ano. V každém případě to takto bude fungovat rychleji ;)

Nicméně mi přijde naprosto zbytečný cyklus - který Palooo tak rád používá ;))
Čímž pádem je mé řešení rychlejší - ale vaše volba. Hlavně, že to funguje ;)citovat
#014191
avatar
eLCHa: cyklus to je zivot :)) .... btw. snazim sa programovat tak aby som data necyklil ... zatial bezuspesne :)))citovat

Strana:  « předchozí  1 2 3

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