< návrat zpět

MS Excel


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

Zaslal/a 2.10.2020 22:49

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ěď >

#048211
elninoslov
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 Sub
citovat
#048212
Stalker
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: zip48212_test-vymazani-oblasti.zip (284kB, staženo 15x)
citovat
#048213
elninoslov
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 Sub
citovat
#048214
avatar
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
#048216
elninoslov
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
#048217
elninoslov
@ 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
#048226
Stalker
To elnino
To ukládání oblastí do pole a opětovné spojení je zajímavá "fičura" 1
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 6 6 6citovat
#048238
avatar
@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
#048260
avatar
Elninoslov, ještě jednou děkuji za makro. Funguje to dle požadavku.citovat
#048261
Stalker
@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: zip48261_test-vymazani-oblasti-rev.2.zip (285kB, staženo 15x)
citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09