MS Excel

Zdravím, chtěl bych poprosit o malou radu.:
Šlo by udělat následující makro?

Když buňka A1 = "N" pak vymaž buňku B1.
to samé by mělo zkontrolovat u buňky A2 a případně vymazat buňku B2 ...atd celý sloupec.

Umím udělat makro jenom s jednou buňkou, ale aby mi to zkontrolovalo celý sloupec na to nemůžu přijít.

Pokud by někdo poradil. Předem děkuji.

Zaslat odpověď >

elninoslov(3.10.2020 0:24)#048211

Sub VymazB()
Dim Radku As Long, i As Long, A(), rngB As Range

With Worksheets("Data")
'Počet řádků v A
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
'Načíst data do pole (pokud se načítá pole 1x1 je potřeba nastavit dimenzi)
If Radku = 1 Then ReDim A(1 To 1, 1 To 1): A(1, 1) = .Cells(1, "A").Value Else A = .Cells(1, "A").Resize(Radku).Value

'Cyklem projít pole
For i = 1 To Radku
'Kontrola na "n" i "N"
If StrComp(A(i, 1), "N", vbTextCompare) = 0 Then
'Když obsahuje "n" nebo "N", přidej bunku B do oblasti na smazání
If rngB Is Nothing Then Set rngB = .Cells(i, "B") Else Set rngB = Union(rngB, .Cells(i, "B"))
End If
Next i
End With

'Když oblast na smazání existuje, tak smazat najednou
If Not rngB Is Nothing Then rngB.ClearContents
End Subcitovat

Stalker(3.10.2020 1:11)#048212

To elnino:
Ahoj, šel sem na to v podstatě stejně viz soubor, ale mám velkou oblast dat A1:A40200 viz tazatelův požadavek - aby mi to zkontrolovalo celý sloupec

Makro však zdechne, vlastně obě.
Přetečení rng ???
Máš nějaký elegantní tip, jak z toho ven?

Příloha: zip

48212_test-vymazani-oblasti.zip (284kB, staženo 16x)

citovat

elninoslov(3.10.2020 3:25)#048213

Bunka po bunke to proste dlho trvá, a stále sa to s časom spomaľuje. Rozdeliť to na menšie časti, a tie potom spojiť. Príklad:
Sub VymazB2()
Dim Radku As Long, i As Long, A(), rngB As Range, Counter As Long, cRngs As Long, tR() As Range

With Worksheets("List1")
'Počet řádků v A
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
'Načíst data do pole (pokud se načítá pole 1x1 je potřeba nastavit dimenzi)
If Radku = 1 Then ReDim A(1 To 1, 1 To 1): A(1, 1) = .Cells(1, "A").Value Else A = .Cells(1, "A").Resize(Radku).Value

'Cyklem projít pole
For i = 1 To Radku
'Kontrola na "n" i "N"
If StrComp(A(i, 1), "N", vbTextCompare) = 0 Then
Counter = Counter + 1
'Když obsahuje "n" nebo "N", přidej bunku B do oblasti na smazání
If rngB Is Nothing Then Set rngB = .Cells(i, "B") Else Set rngB = Union(rngB, .Cells(i, "B"))
If Counter = 1000 Then cRngs = cRngs + 1: ReDim Preserve tR(cRngs): Set tR(cRngs) = rngB: Set rngB = Nothing: Counter = 0
End If
Next i
End With

'Když oblast na smazání existuje, tak smazat najednou
If Counter + cRngs > 0 Then
For i = 1 To UBound(tR)
If rngB Is Nothing Then Set rngB = tR(i) Else Set rngB = Union(rngB, tR(i))
Next i
If Not rngB Is Nothing Then rngB.ClearContents
End If
End Subcitovat

kalisci(3.10.2020 8:22)#048214

Děkuji Elninoslov, funguje to (mluvím o tom prvním makru)

Možná bych se ještě zeptal,
a poprosil o úpravu makra, aby prohledávalo jenom určenou oblast: A1:A500. Není nutné celý sloupec.... Tolik dat zase mít nebudu.

Děkuji moc.citovat

elninoslov(3.10.2020 8:51)#048216

Ale on sa neprehľadáva celý stĺpec, ale iba oblasť od 1. po posledný vyplnený riadok. Teda ak sú data od 1 po 80, tak 80 riadkov, ak od 1 po 530 tak 530 riadkov, ak od 1 po 780963 tak ...
Na rýchle určenie slúži tento riadok:
Radku = .Cells(Rows.Count, "A").End(xlUp).Rowcitovat

elninoslov(3.10.2020 9:57)#048217

@ Stalker :
Kvôli rýchlosti prevedenia, by som na Vašom mieste zvážil "bleskovicu" s aplikovaním dočasného filtra spolu so SpecialCells, napr:
Sub VymazB3()
Dim Radku As Long

Application.ScreenUpdating = False
With Worksheets("List1")
'Počet řádků v A
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
If Radku = 1 Then Exit Sub

With .Range("A1:B" & Radku)
'Dočasně aplikovat filtr
.AutoFilter
.AutoFilter Field:=1, Criteria1:="=N"

On Error Resume Next
'Validní buňky v B smazat najednou
.Columns(2).Resize(Radku - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).ClearContents
On Error GoTo 0

'Zrušit dočasný filtr
.AutoFilter
End With
End With
Application.ScreenUpdating = True
End Sub
Len teda A1:B1 musí byť hlavička.citovat

Stalker(4.10.2020 23:10)#048226

To elnino
To ukládání oblastí do pole a opětovné spojení je zajímavá "fičura"

Diky za to, ukládám do archivu.

I když celá věc byla na konec zbytečná, Celý sloupec vlastně znamená rozsah 1 až 500

citovat

lubo(6.10.2020 10:15)#048238

@elninoslov

Vlastnost SpecialCells má "drobnou" chybičku. Pokud je aplikována jen na jednu buňku je dobré tento případ ošetřit samostatně. V listu klidně vybere celý sešit, tady, pokud je "n" jen na prvním místě v seznamu, vybere celý sešit mimo skrytých řádků a smaže ho. Tj. smaže hlavičku i první řádek v seznamu.

Osobně považuji za nejrychlejší, pokud netrvám na použití ClearContents, variaci na téma: Načíst do pole oba sloupce, příslušné pole nahradit prázdným řetězcem a pak celé pole vrátit zpět.citovat

kalisci(7.10.2020 19:17)#048260

Elninoslov, ještě jednou děkuji za makro. Funguje to dle požadavku.citovat

Stalker(7.10.2020 22:40)#048261

@Lubo

Osobně považuji za nejrychlejší, pokud netrvám na použití ClearContents, variaci na téma: Načíst do pole oba sloupce, příslušné pole nahradit prázdným řetězcem a pak celé pole vrátit zpět.

Dobrej tip, v jednoduchosti je síla.

Příloha: zip

48261_test-vymazani-oblasti-rev.2.zip (285kB, staženo 16x)

citovat

Téma: Jak vymazat buňku v závislosti na obsahu jíno

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje