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 Ifcitovat
P.
Např.:
If .Value Like "MW-*" Then
.EntireRow.Delete
End Ifcitovat
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: smazat radek na zakládě podmínky
MS Excel
Téma: smazat radek na zakládě podmínky 
Zaslal/a Fantasyk 27.1.2022 9:14
Zdraví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: 
51993_smazat_radek_podminka.zip (16kB, staženo 11x)
51993_smazat_radek_podminka.zip (16kB, staženo 11x)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 Subcitovat
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 Subcitovat
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