• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Psal jsem to z fleku ale nevidím důvod.

Vzorek?

teď vyzkoušeno

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 2
ListBox1.RowSource = "List1!A1:B12"
End Sub

funkční

On Error Resume Next
Workbooks("XY").Activate
If Not Err.Number = 0 Then
Workbooks.Open "XY"
End If
On Error Goto 0

ActiveWorkbook.Close - to je ta chyba viz. 2.příspěvek

Takže jsem ho zrovna trefil? ;))

Ale jestli můžu požádat o způsob jak adresovat ten soubor z Personal ...
Možností je více. Ale napadá mě

ActiveSheet

nebo ListBox se seznamem otevřených souborů
( určit ten správný sešit z několika otevřených, kde to makro bude pracovat.)
a vybrat

Co znamená?

ActiveWorkbooks.Close

To makro by snad asi nemělo ani fungovat.

Zavrhnul jsem několik jiných možností, vyšlo mi nejlíp mít
v každém souboru stejné makro s jiným názvem a jinou kláv.zkratkou

Byla v tom i možnost vložit to makro do PERSONAL (nebo doplnku)? Stačila by jedna zkratka, popř. nabídka a v případě opravy by se opravovalo jediné místo

mám položky: sloupec A Název položky, sloupec B Datum.

ListBox1.ColumnCount=2
ListBox1.RowSource="List3!AxBy"

Musí to být nutně makrem?

Nestačí
=COUNTIF($A$2:$A$x;C2)+COUNTIF($B$2:$B$x;C2)

a zkopírovat?
Když je výsledek 0 tak je to to co hledáte.

Zkontrolovat externí odkazy (pokud jsou a odkazovaný soubor není otevřen - VÝRAZNĚ zpomaluje)

když nepomůže

Vypnout automatický přepočet (Calculation)
Vypnout překreslování (ScreenUpdating)
Vypnout automatické události (EnableEvents)

když nepomůže

Dát si kafe nebo zajít na oběd

Třeba.

s svyhledat jsem si chvilku hrál, ale podle mě je to krám

s tím tak trochu souhlasím, používám už pouze vyjímečně

Pokud máte databázi a chcete hledat jinde než v prvním sloupci, používejte kombinaci POZVYHLEDAT a POSUN (nebo INDEX). Nemusíte tak použít maticový vzorec, což oceníte při jeho kopírování.

Mno - tak bych to tipoval na nekorektní uzavření

jak postupovat teď stačí změnit adresář na požadovanou složku?
To bych asi nedělal. Stává se vám, že vám excel spadne?

Těžko říct. První co mě napadá
Jaký máte adresář pro automatické obnovení?

Ehm - A čo si predstavujete pod takým pojmom 'suchý řádek'
;)

Sub Makro1()
Dim rRange As Range
Set rRange = Intersect(Range("F:F"), Range("B:B").SpecialCells(xlCellTypeConstants).EntireRow)
rRange.FormulaR1C1 = "=MID(RC2,9,32767)"

'pokud to chcete v hodnotách a ne ve vzorcích tak odkomentujte následující řádky
' Set rRange = Intersect(rRange.EntireColumn, ActiveSheet.UsedRange)
' rRange.Value = rRange.Value

Set rRange = Nothing
End Sub

A ještě

Pokud byste to chtěla dělat po buňkách, tak nemusíte použít Replace ale

Dim w As Workbook
Dim sh As Worksheet
Dim r As Range
For Each w In Application.Workbooks
For Each sh In w.Worksheets
For Each r In sh.Cells
With r
.Value = IIf(.Value = 0, vbNullString, .Value)
End With 'r
Next r
Next sh
Next w

Set r = Nothing
Set sh = Nothing
Set w = Nothing

Mno koukám, že by to chtělo ještě vypnout kalkulace, japato protože ty vám to můžou 'kapánek zpomalit' ;)

Sub Preved_nahodnoty_a_smaz_nuly()
With Application
Dim bScreen As Boolean
bScreen = .ScreenUpdating
.ScreenUpdating = False
Dim lCalc As Long
lCalc = .Calculation
.Calculation = xlCalculationManual
End With 'Application

Dim w As Workbook
Dim sh As Worksheet
For Each w In Application.Workbooks
For Each sh In w.Worksheets
With sh.Range("K1:M200")
.Value = .Value
.Replace What:="0", Replacement:="", LookAt:=xlWhole
End With 'sh.Range("K1:M200")
Next sh
Next w

Set sh = Nothing
Set w = Nothing

With Application
.Calculation = lCalc
.ScreenUpdating = bScreen
End With 'Application
End Sub

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje