Filter, rozšírený filter (možno by šlo i cez kontingenčnú tabuľku). Nič z toho nestačí?
Osobne by som použil FSO. Nastav si referenciu na Microsoft Scripting Runtime a uprav si kód, vzor ktorého prikladám:Sub kopiruj()
'rutina skopiruje vsetky subory txt, ktorych nazov má na konci SAP plus 2 znaky
'z adresara C:\Documents and Settings\al\Desktop\
'do adresara C:\Documents and Settings\al\Desktop\novy\
'pozor, cielovy adresar musi byt pred spustenim kodu uz vytvoreny
Dim myObject As Scripting.FileSystemObject, mySourceFolder As Scripting.Folder
Dim myFile As Scripting.File
Set myObject = New Scripting.FileSystemObject
Set mySourceFolder = myObject.GetFolder("C:\Documents and Settings\al\Desktop\") 'nastav si zdrojovy adresar
For Each myFile In mySourceFolder.Files
If myFile.Name Like "*SAP??.txt*" Then 'nastav si masku napr: "??_14_###.xls*", "???.pdf", "*.pdf" alebo aku potrebujes
myFile.Copy "C:\Documents and Settings\al\Desktop\novy\" & myFile.Name, True 'nastav cielovy adresar
End If
Next myFile
End Sub
to True tuná:myFile.Copy "C:\Documents and Settings\al\Desktop\novy\" & myFile.Name, True existujúci súbor prepíše, pokiaľ chceš zachovať pôvodný, zmeň na False
buď rank, ako píše marjankaj, alebo, pokiaľ máš jednotlivé tipy v stĺpci A, tak do B1 zapíš
=ABS(8200-A1)<50
a skopíruj dolu, spočítaj, u koľkých hodnôt Ti vyjde PRAVDA a na základe toho zmeň hodnotu 50 v tom vzorci
@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?
@Palooo: mno, s hlupákom by som v Tvojom prípade rozhodne neoperoval, každopádne, eLCHa aktuálne diktuje :)
@eLCHa: njn, učím sa :)
@Palooo: Znovu podotýkam, že nie som detailne oboznámený s problémom, ktorý riešite, ničmenej, to, čo som zmienil ja, by vyzeralo nejako takto: With Range("C1:C100")
.FormulaArray = "=RC[-2]:R[99]C[-2]&RC[-1]:R[99]C[-1]"
.Copy
.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
edit: a inšpirovaný výborným trikom eLCHy nejak takto:
With Range("C1:C100")
.FormulaArray = "=RC[-2]:R[99]C[-2]&RC[-1]:R[99]C[-1]"
.Value = .Value
End With
no, a nakoniec, ani ten maticový vzorec nie je nevyhnutný: With Range("C1:C100")
.Formula = "=RC[-2]&RC[-1]"
.Value = .Value
End With
@FunBcz: Keby som bol prišiel na to, ako to vyriešiť bez pomocného stĺpca, tak by som to sem bol býval dal :(. UDF vo VBA no problem, na liste ale netuším.... (a UDF na takú prkotinu sa mi písať nechce).
@Paloo: rychlejsie to nepojde .. nenasiel som funkciu ktora by naraz spojila stlpce do jedneho stlpca :)
možno off-topic, páč toto vlákno som podrobne neprechádzal, ale spojiť napr. A1:A100 a B1:B100 do C1:C100 ide maticovým vzorcom zadaným v C1:C100 v tvare
A1:A100&B1:B100, analogicky je možno použiť i vo VBA (FormulaArray) ako argumenty eventuálne použiť pomenované oblasti (na konci prípadne nahradiť hodnotami)
@marjankaj: vzhľadom k tomu, že v zadaní boli i mínusové hodnoty, tak som predpokladal, že sa jedná o prírastky a úbytky. Ničmenej, pravdou je, že zadávatelia nie sú príliš jednoznační pri popise problému, takže to chce občas krištálovú guľu. Tipujem, že kolega rieši nejaký trading, poslednou dobou sa tu množia príspevky o komoditách, stop-lossoch a profit-takingoch, toto bude najskôr úloha z daného ranku, žiadna hladina Dunaja
šak hej, ja som to pochopil :)
Pokiaľ Ti nevadí pomocný stĺpec, tak napr.
[b1]: =KDYŽ(A1<0;A1;0)
[b2]: =KDYŽ(A2+B1<0;A2+B1;0)
skopíruj dolu
ten Tvoj max pokles potom zistíš ako minimum z hodnôt v stĺpci B
@marjankaj: eLCHa má pravdu, funkcia OFFSET je jednoduchšia.
len poznamenám, že jednoduchšia na pochopenie je, a je tradične používaná napr. pre dynamické vymedzenie datových sád grafu, ale na rozdiel od Index je volatilná...
Je to tak, proste, si iný level
Spusti záznamník makra a nastav si oblasť tlače. Vypni záznamník. Dostaneš základ kódu, ten si budeš musieť zeditovať. V cykle zisti posledný stĺpec a posledný riadok, v ktorých sa nachádza bunka bez prázdneho znaku, osobne by som asi začal od konca, čiže určil poslednú použitú bunku cez [A1].SpecialCells(xlLastCell) a hľadal v cykle prvú s neprázdnym znakom (t.j. tú, ktorá sa už má tlačiť)no a následne nastavil oblasť tlače od A1 po uvedenú bunku.
Neviem síce, čo myslíš názvom a čo pomenovaním listu, každopádne, pokiaľ budeš mať v stĺpci M názvy listov (to isté, čo vidíš na uškách listov), tak fungovať by to mohlo takto (bola tam ďalšia chyba, a to v prvej podmienke If):Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim Radek As Long
Radek = ActiveCell.Row
If target.Address = ActiveSheet.Cells(Radek, 14).Address Then
a = ActiveSheet.Cells(Radek, 14).Value 'volba
b = ActiveSheet.Cells(Radek, 13).Value 'volba
If a <> "" Then
nazev = b
ActiveSheet.Cells(Radek, 4).Value = "ANO"
ActiveWorkbook.Save
Worksheets(nazev).Select
End If
End If
End Sub
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
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.