excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: smazání "0" v buňce, nahradit "pr
MS Excel
Téma: smazání "0" v buňce, nahradit "pr 
Zaslal/a renca 11.4.2013 16:43
Dobrý den,
úplný amatér, prosím o radu na makro.
Ve sloupcích K:M (200 řádků) se vyskytuje výsledek "0" a místo nuly, bych měla mít prázdnou buňku.
Díky moc
Ještě je jedna možnost. Může zůstat nula, ale v nastavení Excelu Soubor>Možnosti>Upřesnit najdi a zruš zaškrtnutí pro zobrazovat nulu. Z Tvého požadavku není úplně jasné, zda chceš prázdné buňky nebo jen neviditelné nuly.citovat
Díky moc za radu, problém byl, že jsem neměla pole "Pouze celé buňky" zaškrtnuté, v makro jsem měla "part" místo "Whole".
ZDE je makro:
nejdřív převede buňky na hodnoty a pak místo "0" nahradí "nic".
CHTĚLA jsem se zeptat!!!! jestli jde napsat toto makro a spustit nad více sešity najednou, abych nemusela každý sešit otevřít zvlášť a pustit makro.
Díky moc
Sub Preved_nahodnoty_a_smaz_nuly()
Dim Lst As Worksheet
Dim Bunka As Object
Application.ScreenUpdating = False
For Each Lst In ActiveWorkbook.Worksheets
Range("K1:M200").Select ' zde si dopln jak potrebujes
For Each Bunka In Selection
Bunka = Bunka.Value
Next Bunka
Next Lst
Columns("K:M").Select
Selection.Replace What:="0%", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Subcitovat
ZDE je makro:
nejdřív převede buňky na hodnoty a pak místo "0" nahradí "nic".
CHTĚLA jsem se zeptat!!!! jestli jde napsat toto makro a spustit nad více sešity najednou, abych nemusela každý sešit otevřít zvlášť a pustit makro.
Díky moc
Sub Preved_nahodnoty_a_smaz_nuly()
Dim Lst As Worksheet
Dim Bunka As Object
Application.ScreenUpdating = False
For Each Lst In ActiveWorkbook.Worksheets
Range("K1:M200").Select ' zde si dopln jak potrebujes
For Each Bunka In Selection
Bunka = Bunka.Value
Next Bunka
Next Lst
Columns("K:M").Select
Selection.Replace What:="0%", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Subcitovat
Upozorňuji, že jsem pouze upravil vaše makro. Bez testování. Vyzkoušejte, ale opatrně.
For Each w In Application.Workbooks
toto znamená, že se provede pro všechny otevřené sešity
není tam žádná kontrola zámků atp.
dejte vědět, zda to tak stačí
Sub Preved_nahodnoty_a_smaz_nuly()
Dim bScreen As Boolean
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
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
Application.ScreenUpdating = bScreen
End Subcitovat
For Each w In Application.Workbooks
toto znamená, že se provede pro všechny otevřené sešity
není tam žádná kontrola zámků atp.
dejte vědět, zda to tak stačí
Sub Preved_nahodnoty_a_smaz_nuly()
Dim bScreen As Boolean
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
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
Application.ScreenUpdating = bScreen
End Subcitovat
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 Subcitovat
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 Subcitovat
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 = Nothingcitovat
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 = Nothingcitovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články