MS Excel

Dobrý den,
chci se zeptat, zda byste mi pomohli s makrem, které by vymazalo na listu, který je ve formátu tabulky příslušný řádek, když je v konkrétním sloupci nějaký hodnota?
Na listu "faktury" mám tabulku "DataFaktury".
A potřeboval bych, aby makro konkrétně ve sloupci číslo 11 prohledávalo jednotlivé buňky a pokud by byla v buňce hodnota "#NENÍ_K_DISPOZICI", tak by se řádek s touto hodnotou vymazal.
A takto by to zkontrolovalo a případně vymazalo všechny buňky (řádky) v tom sloupci číslo 11.
Děkuji.
Radek

Zaslat odpověď >

Strana: 1 2 další »

Alfan(7.2.2023 14:02)citovat#054370

Vyřešeno:
Sub DeleteRows()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("faktury")

Dim tbl As ListObject
Set tbl = ws.ListObjects("DataFaktury")

Dim lastRow As Long
lastRow = tbl.Range.Rows.Count

Dim i As Long
For i = lastRow To 1 Step -1
If IsError(tbl.DataBodyRange.Cells(i, 11).Value) Then
tbl.DataBodyRange.Rows(i).Delete
End If
Next i

MsgBox ("ŘÁDKY VYMAZÁNY")

End Sub

elninoslov(7.2.2023 21:49)citovat#054371

Ja by som to videl na SpecialCells
Sub DeleteRows()
Dim rngErr As Range, ErrCount As Long

With wsFaktury.ListObjects("DataFaktury")
On Error Resume Next
Set rngErr = .ListColumns(11).Range.SpecialCells(xlCellTypeFormulas, xlErrors) 'všechny buňky s chybou ve 11. sloupci Tabulky
On Error GoTo 0

If rngErr Is Nothing Then MsgBox "Žádné chyby", vbInformation: Exit Sub 'žádné chyby

ErrCount = rngErr.Cells.Count
' If ErrCount = .DataBodyRange.Rows.Count Then .ListRows.Add 'asi není potřeba, ale pokud jsou všechny buňky s chybou, přidej 1 řádek, pro zachování vzorců a formátů

Intersect(.DataBodyRange, rngErr.EntireRow).Delete Shift:=xlUp 'odstranění řádků
MsgBox "VYMAZÁNO " & ErrCount & " ŘÁDKŮ", vbExclamation 'informativní výpis počtu chyb
End With
End Sub

Příloha: zip

54371_mazanie-riadkov-tabulky-s-chybou.zip (17kB, staženo 2x)

Alfan(8.2.2023 7:22)citovat#054372

Děkuji

Já ještě budu testovat to moje původní s tím, že buď to bude na Error nebo na konkrétní text nebo na konkrétní hodnotu:
If IsError(tbl.DataBodyRange.Cells(i, 11).Value) Then tbl.DataBodyRange.Rows(i).Delete

If tbl.DataBodyRange.Cells(i, 11).Value = "něco" Then tbl.DataBodyRange.Rows(i).Delete

If tbl.DataBodyRange.Cells(i, 11).Value = 900 Then tbl.DataBodyRange.Rows(i).Delete

elninoslov(8.2.2023 18:54)citovat#054373

Takto?
Sub DeleteRows()
Dim rngDel As Range, DelCount As Long, D(), i As Long, bDel As Boolean

With wsFaktury.ListObjects("DataFaktury")
With .ListColumns(11).Range
D = .Value2
For i = 2 To UBound(D, 1)
bDel = IsError(D(i, 1)) 'mazat při chybě
If Not bDel Then
Select Case D(i, 1)
Case "něco", 900: bDel = True 'nebo mazat při těchto hodnotách, hodnoty lze lehce přidat
End Select
End If

If bDel Then If rngDel Is Nothing Then Set rngDel = .Cells(i) Else Set rngDel = Union(rngDel, .Cells(i))
Next i
End With

If rngDel Is Nothing Then MsgBox "Žádné řádky k smazání", vbInformation: Exit Sub 'žádné řádky k smazání

DelCount = rngDel.Cells.Count
Intersect(.DataBodyRange, rngDel.EntireRow).Delete Shift:=xlUp 'odstranění řádků
MsgBox "VYMAZÁNO " & DelCount & " ŘÁDKŮ", vbExclamation 'informativní výpis počtu chyb
End With
End Sub

Příloha: zip

54373_mazanie-riadkov-tabulky-s-chybou-a-zadanou-hodnotou.zip (21kB, staženo 2x)

Alfan(9.2.2023 9:57)citovat#054377

Super, to je ono.

Jen mě ještě napadlo, jestli by se dal použít třeba nějaký pomocný list, třeba s názvem "hodnoty", kde by se pod sebe v prvním sloupci zadaly hodnoty (makro by prohledalo první sloupec), které by se využili v této části makra.

Case "něco", 900: bDel = True 'nebo mazat při těchto hodnotách, hodnoty lze lehce přidat

Jen proto, aby někdo nemusel editovat makro.

Ale jinak je pro mě i toto dostačující.
Ještě jednou děkuji.
Radek

elninoslov(9.2.2023 13:52)citovat#054381

To je úplne jednoduché.
Sub DeleteRows()
Dim rngDel As Range, DelCount As Long, D(), i As Long, colDel As New Collection, Check

D = wsHodnoty.ListObjects("tblMazatHodnoty").ListColumns(1).Range.Value2
On Error Resume Next
For i = 2 To UBound(D, 1) 'vytvoření kolekce mazaných hodnot z tblMazatHodnoty
colDel.Add CStr(D(i, 1)), CStr(D(i, 1))
Next i

With wsFaktury.ListObjects("DataFaktury")
With .ListColumns(11).Range
D = .Value2

For i = 2 To UBound(D, 1)
Check = colDel(CStr(D(i, 1))) 'mazat při hodnotách z tblMazatHodnoty, hodnoty lze lehce editovat
If Err.Number = 0 Then
If rngDel Is Nothing Then Set rngDel = .Cells(i) Else Set rngDel = Union(rngDel, .Cells(i))
Else
Err.Clear
End If
Next i
End With
On Error GoTo 0

If rngDel Is Nothing Then MsgBox "Žádné řádky k smazání", vbInformation: GoTo KONEC 'žádné řádky k smazání

DelCount = rngDel.Cells.Count
Intersect(.DataBodyRange, rngDel.EntireRow).Delete Shift:=xlUp 'odstranění řádků
MsgBox "VYMAZÁNO " & DelCount & " ŘÁDKŮ", vbExclamation 'informativní výpis počtu chyb
End With

KONEC:
Set colDel = Nothing
End Sub
A nebolo by pre Vás vhodnejšie PowerQuery s výslednou Tbl do druhého listu/súboru ???

Příloha: zip

54381_mazanie-riadkov-tabulky-podla-zadanych-hodnt-v-tbl.zip (24kB, staženo 3x)

Alfan(10.2.2023 8:16)citovat#054387

Děkuji

To PQ asi ne, protože ne všichni mají Office, kde PQ běží.

Alfan(15.2.2023 7:13)citovat#054464

@elninoslov
Přeci jenom se chci zeptat, jak by bylo složité toto řešit přes PQ, jak píšete?
Jak jste mi popsal tu Transpozici přes PQ, tak to bylo pro mne pochopitelné.
Děkuji.
Radek

Alfan(15.2.2023 15:47)citovat#054466

elninoslov napsal/a:

Ja by som to videl na SpecialCells
Sub DeleteRows()
Dim rngErr As Range, ErrCount As Long

With wsFaktury.ListObjects("DataFaktury")
On Error Resume Next
Set rngErr = .ListColumns(11).Range.SpecialCells(xlCellTypeFormulas, xlErrors) 'všechny buňky s chybou ve 11. sloupci Tabulky
On Error GoTo 0

If rngErr Is Nothing Then MsgBox "Žádné chyby", vbInformation: Exit Sub 'žádné chyby

ErrCount = rngErr.Cells.Count
' If ErrCount = .DataBodyRange.Rows.Count Then .ListRows.Add 'asi není potřeba, ale pokud jsou všechny buňky s chybou, přidej 1 řádek, pro zachování vzorců a formátů

Intersect(.DataBodyRange, rngErr.EntireRow).Delete Shift:=xlUp 'odstranění řádků
MsgBox "VYMAZÁNO " & ErrCount & " ŘÁDKŮ", vbExclamation 'informativní výpis počtu chyb
End With
End SubPříloha: 54371_mazanie-riadkov-tabulky-s-chybou.zip (17kB, staženo 1x)

Vždycky se mi to zasekne na:
With wsFaktury.ListObjects("DataFaktury")

elninoslov(15.2.2023 16:17)citovat#054467

Dnes ma neskutočne bolí rameno. Človek by neveril, ako hýbe ramenom pri prekladaní ruky z myši na klávesku. Ak to nepovolí, nerobím dnes ani prd ... sorry.

Příloha: png

54467_codenamelist.png (97kB, staženo 20x)

Strana: 1 2 další »

Téma: Výmaz řádku podle hodnoty v konkrétním sloupci

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje