< návrat zpět

MS Excel


Téma: smazat radek na zakládě podmínky rss

Zaslal/a 27.1.2022 9:14

FantasykZdravím,
mám kód, který mi smaže řádek na základě podmínky:
Ve sloupci B najde "MW-", ale potřeboval bych, aby mi to smazalo všechny řádky, ve kterých najde MW-1 MW-2 atd..

Díky za pomoc

Příloha: zip51993_smazat_radek_podminka.zip (16kB, staženo 10x)
Zaslat odpověď >

#051994
avatar
Místo příkazu "Select Case" mě napadá využití podmínky "If" a zástupného znaku.
P.

Např.:
If .Value Like "MW-*" Then
.EntireRow.Delete
End If
citovat
#052003
elninoslov
Sub smazat_radek()
Dim Firstrow As Long
Dim Countrows As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim aDataB()
Dim rngDel As Range
Dim rngRange As Range

Const constMARK = "MW-"

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With

With ActiveSheet
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = .UsedRange.Row
Countrows = .UsedRange.Rows.Count
Set rngRange = .Cells(Firstrow, "B").Resize(Countrows)

If Countrows = 1 Then ReDim aDataB(1 To 1, 1 To 1): aDataB(1, 1) = .Cells(Firstrow, "B").Value Else aDataB = rngRange.Value

For Lrow = 1 To Countrows
If Not IsError(aDataB(Lrow, 1)) Then
If Left$(aDataB(Lrow, 1), Len(constMARK)) = constMARK Then
If rngDel Is Nothing Then Set rngDel = rngRange.Cells(Lrow) Else Set rngDel = Union(rngDel, rngRange.Cells(Lrow))
End If
End If
Next Lrow
End With

If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
ActiveWindow.View = ViewMode
With Application
.Calculation = CalcMode
End With
Beep
End Sub
citovat
#052004
Fantasyk
Díky elninoslov funguje 1citovat

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

Porovnávací Tabulka

lubo • 25.6. 10:09

Porovnávací Tabulka

Jirka78 • 25.6. 9:21

Porovnávací Tabulka

Jess • 25.6. 6:46

rozlisna tlac excelu na 2 pc

elninoslov • 24.6. 23:28

Porovnávací Tabulka

elninoslov • 24.6. 23:26

Porovnávací Tabulka

Jess • 24.6. 22:46

rozlisna tlac excelu na 2 pc

Michalko • 24.6. 7:04