Öncelikle herkese kolay gelsin, daha öncede bu konuyu taşıdım ancak çözüme kavuşturamadım. yada ben anlayamadım. tekrar açmak gereği duydum.
ekteri çalışmamda;
Satır sil makrosu hata veryor. İlk tıklamada sıfır değeri varsa onları seçip HATA uyarısı veriyor ve silmeden bırakıyor.
Sıfır değeri yoksa tüm verileri filltreleme yaparak GİZLİYOR BAKİYE sütunundeki filtre kaldırılmadan görülmüyor.
Satır Silme Makrosu Hatası
yalnız ben oradaki 7. mesajda size hem bir sormuştum hem de kodu değiştirmiştim, bu çalışmadaki kod, bu haliyle sorun çıkarabilir. o mesajı tekrar okuyup soruya cevap verebilir misiniz?
sonstr = Syf.Cells(Syf.Rows.Count, "h")==> yerine sonstr = Syf.Cells(Syf.Rows.Count, "A") dener misiniz?
sonstr = Syf.Cells(Syf.Rows.Count, "h")==> yerine sonstr = Syf.Cells(Syf.Rows.Count, "A") dener misiniz?
Sub KapananHesabıSil()
Dim Syf As Worksheet
Set Syf = ThisWorkbook.Worksheets("Vadeli Hesap")
On Error GoTo 10
With Syf
sonstr = .Cells(.Rows.Count, "A").End(xlUp).Row
.ListObjects("Vadeli_Hesap").Range.AutoFilter Field:=7, Criteria1:="0,00"
Set rng = .Range("A2:a" & sonstr).Rows.SpecialCells(xlCellTypeVisible)
dz = Replace(rng.Address, "$A$", "")
Debug.Print dz
dizi = Split(dz, ",")
For x = UBound(dizi) To LBound(dizi) Step -1
.Range("A" & dizi(x)).EntireRow.Delete
Next x
End With
10
Syf.ListObjects("Vadeli_Hesap").Range.AutoFilter Field:=7
End Sub
yada aşağıdaki kodu deneyebilirsiniz
Sub KriterliSil()
Dim tbl As ListObject
Dim rng As Range
Set tbl = ThisWorkbook.Worksheets("Vadeli Hesap").ListObjects("Vadeli_Hesap")
' Filter and delete all rows that have criteria
With tbl.Range
.AutoFilter
.AutoFilter Field:=7, Criteria1:="0,00"
' Set the range for the filtered cells
Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
.AutoFilter ' Turn off the filter
rng.Delete ' Delete the filtered cells
End With
End Sub
Sub KapananHesabýSil()
Dim Syf As Worksheet, sonstr As Long, i As Long
Set Syf = ThisWorkbook.Worksheets("Vadeli Hesap")
Application.Calculation = xlCalculationManual
With Syf
On Error Resume Next
.ShowAllData
On Error GoTo 0
On Error GoTo son
sonstr = .Cells(Syf.Rows.Count, "A").End(xlUp).Row
If sonstr < 2 Then goto son
For i = sonstr To 2 Step -1
If Val(.Cells(i, "g").Value2) = 0 Then .Range("A" & i).EntireRow.Delete
Next
End With
son:
Application.Calculation = xlCalculationAutomatic
Set Syf = Nothing
End Sub
Önceki mesajda exit sub yazmışım ora değişti.Ve
eklendi.
Kod:
If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) = 0 Then GoTo son
Sub KapananHesabýSil()
Dim Syf As Worksheet, sonstr As Long, i As Long
Set Syf = ThisWorkbook.Worksheets("Vadeli Hesap")
With Syf
On Error Resume Next
.ShowAllData
On Error GoTo 0
On Error GoTo son
If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) = 0 Then GoTo son
Application.Calculation = xlCalculationManual
sonstr = .Cells(.Rows.Count, "A").End(xlUp).Row
If sonstr < 2 Then GoTo son
For i = sonstr To 2 Step -1
If Val(.Cells(i, "g").Value2) = 0 Then .Range("A" & i).EntireRow.Delete
Next
End With
son:
Application.Calculation = xlCalculationAutomatic
End Sub
Yada bunu deneyin.Filtrelimi diye şart eklendi.
Sub KapananHesabySil()
Dim Syf As Worksheet, sonstr As Long, i As Long
Set Syf = ThisWorkbook.Worksheets("Vadeli Hesap")
With Syf
If .ListObjects("Vadeli_Hesap").AutoFilter.FilterMode = True Then .ShowAllData
On Error GoTo son
If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) = 0 Then GoTo son
Application.Calculation = xlCalculationManual
sonstr = .Cells(.Rows.Count, "A").End(xlUp).Row
If sonstr < 2 Then GoTo son
For i = sonstr To 2 Step -1
If Val(.Cells(i, "g").Value2) = 0 Then .Range("A" & i).EntireRow.Delete
Next
End With
son:
Application.Calculation = xlCalculationAutomatic
End Sub
Konuyu Okuyanlar: 1 Ziyaretçi