Stránka 1 z 2
VBA Excel - smazání určitého řádku
Napsal: 18 bře 2010 08:08
od Branscombe
Ahoj, potřeboval bych poradit se zápisem vzorce ve VBA.
Potřebuji smazat každý řádek v listu který má ve sloupci A hodnotu 7.
Raděj ani nebudu psát jak jsem to vymyslel já, stejně to nefunguje a akorát byste se asi pobavili
Re: VBA Excel - smazání určitého řádku
Napsal: 18 bře 2010 08:57
od navstevnik
Nasel jsem v archivu proceduru odstranujici radky, a to bud obsahujici v nektere bunce urcitou hodnotu nebo kazdy n-ty radek (podle aktivace casti kodu mezi radky *******), uprav si:
Kód: Vybrat vše
Option Explicit
' odstrani kazdy n-ty radek nebo radek jehoz hodnota = Hodnota
Sub OdstranRadek()
Dim MyArea As Range, MyCell As Range
Dim PoslRadek As Long, NasRadku As Byte
Dim Odstran As Range, Ofs As Long, Hodnota As Variant
Set MyArea = Worksheets("odstranradky").UsedRange
If IsEmpty(MyArea) Then End
PoslRadek = MyArea.Rows.Count ' Worksheets("odstranradky").UsedRange.Rows.Count
Application.ScreenUpdating = False
' bud odstrani kazdy n-ty radek:
' NasRadku=(1;2;3;4;...,255) - odstrani kazdy(lichy,sudy, 3-ti, 4-ty,...,255-ty) radek
'*********************
' NasRadku = 2 ' nastavit
' If NasRadku = 1 Then
' Set Odstran = Worksheets("odstranradky").Range("2:2").Rows
' Ofs = -1: NasRadku = 2
' Else
' Set Odstran = Worksheets("odstranradky").Range("1:1").Rows
' Ofs = NasRadku - 1
' End If
' Do While Ofs < PoslRadek ' odstrani kazdy n-ty radek
' If Ofs = 0 Then Ofs = 1
' Odstran.Offset(Ofs, 0).EntireRow.Delete
' Ofs = Ofs + NasRadku - 1
' PoslRadek = PoslRadek - 1
' Loop
'*********************
' nebo odstrani radek, kde hodnota nektere bunky = Hodnota:
'*********************
Hodnota = "cd" ' nastavit
Set Odstran = Worksheets("odstranradky").Range("1:1").Rows
Ofs = PoslRadek - 1
Do ' odstraneni radku jehoz hodnota = Hodnota
For Each MyCell In Odstran.Offset(Ofs, 0).Cells
If MyCell.Value = Hodnota Then
Odstran.Offset(Ofs, 0).EntireRow.Delete
Exit For
End If
Next MyCell
Ofs = Ofs - 1
Loop While Ofs > -1
'*********************
Range("a1").Select
Application.ScreenUpdating = True
End Sub
Re: VBA Excel - smazání určitého řádku
Napsal: 18 bře 2010 09:41
od Branscombe
Nějak mi to nefunguje. :-/ Zkoušel jsem si to napsat sám podle sebe a někde je chyba...
Mělo by mi to smazat všechny řádky v listu když v buňce ve sloupci "B" je hodnota "7", ale někde je chybička :-/
Kód: Vybrat vše
Sub Smazat()
For A = 733 To Range("a1048576").End(xlUp).Row
If Cells(1, 2) = "7" Then
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
End If
Next A
End Sub
Re: VBA Excel - smazání určitého řádku
Napsal: 18 bře 2010 10:30
od mike007
Tady to máš, koumáku
[vb]
Sub smazat_sedmicky()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A") ' Sloupec s hledanými podmínkami
If Not IsError(.Value) Then
Select Case .Value
Case Is = "7": .EntireRow.Delete 'podmínka v uvozovkách
End Select
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.Calculation = CalcMode
End With
End Sub
[/vb]
Re: VBA Excel - smazání určitého řádku
Napsal: 18 bře 2010 10:39
od Branscombe
Super - funguje... Díky moc, ale to to opravdu nejde zapsat jednodušeji ?? Něco jako jsem psal já ??
Re: VBA Excel - smazání určitého řádku
Napsal: 18 bře 2010 10:58
od mike007
Samozřejmě že jde, ale to předchozí makro provede job v objemných dokumentech rychleji.
Tady máš tedy to jednodušší:
[vb]
Sub smazat_sedmicky()
For a = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(a, 1) = "7" Then Cells(a, 1).EntireRow.Delete
Next a
End Sub
[/vb]
Re: VBA Excel - smazání určitého řádku
Napsal: 18 bře 2010 11:17
od Branscombe
Super, díky
EXCEL VBA - Smázání určitých řádků
Napsal: 19 bře 2010 07:47
od Branscombe
Ahoj, vzhledem k tomu že mi to makro stále nefunguje, přikládám soubor...
Potřeboval bych makro které mi smaže veškeré řádky v oblasti A4:A"poslední buňka" obsahující ve sloupci 2 podmínku z B1 a ve sloupci 3 podmínku z B2
Re: EXCEL VBA - Smázání určitých řádků
Napsal: 19 bře 2010 08:42
od navstevnik
Muzes pouzit napr. tuto proceduru (odstrani vsechny radky mezi vychozim radkem a poslednim radkem splnujicim podminku vcetne techto radku):
Kód: Vybrat vše
Option Explicit
Sub SmazRadky()
Dim Condt1, Condt2, Cll As Range
Dim Blk As Range, i As Long, Tmp As String
With ActiveSheet
' Set Cll = .Range("a4")
On Error Resume Next
Set Cll = Application.InputBox("Zadej vychozi bunku kliknutim mysi nebo vepsanim", , , , , , , Type:=8)
If Err.Number <> 0 Then MsgBox "Chybne zadani": Exit Sub
On Error GoTo 0
Condt1 = .Range("b1").Value
Condt2 = .Range("b2").Value
i = 0
Tmp = vbNullString
Do While Cll.Offset(i, 0).Value <> vbNullString
If Cll.Offset(i, 1).Value = Condt1 And Cll.Offset(i, 2).Value = Condt2 Then
Tmp = Cll.Offset(i, 0).Address(0, 0)
End If
i = i + 1
Loop
If Tmp <> vbNullString Then
Set Blk = .Range("a4:" & Tmp)
' Debug.Print Blk.Address
Blk.EntireRow.Delete
Else
MsgBox "Nebyl nalezen radek splnujici podminky"
End If
End With
Set Cll = Nothing
Set Blk = Nothing
End Sub
Re: EXCEL VBA - Smázání určitých řádků
Napsal: 19 bře 2010 08:55
od Branscombe
Hm... To asi není to co jsem potřeboval, jelikož to maže všechny řádky až do chvíle než to najde řádek dle zadaných kritérií, ale když to nebudu mít seřazeno tak to nebude fungovat ...
Re: VBA Excel - smazání určitého řádku
Napsal: 19 bře 2010 09:24
od mike007
Otevřel jsem staré téma a příspěvky sloučil. Příště téma neoznačuj za vyřešené, když to vyřešené nemáš, nebo případně napiš, abych staré téma znovu odemkl. Díky
Re: VBA Excel - smazání určitého řádku
Napsal: 19 bře 2010 10:07
od Branscombe
Díky, nevěděl jsem jak to s tím odemykáním funguje ...
Nějakou radu na to makro bys neměl ??