Skip to main content

AccessTr.neT


Satır Silme Makrosu Hatası

ercansahiner61
ercansahiner61
25
1618

Satır Silme Makrosu Hatası

Çözüldü #1
Ö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.
.rar SATIR SİL MAKROSUNDA SİLME HATASI.rar (Dosya Boyutu: 99,46 KB | İndirme Sayısı: 4)
Cevapla
#2
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?
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
Cevapla
#3
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
Cevapla
#4
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
Cevapla
#5
Önceki mesajda exit sub yazmışım ora değişti.Ve
Kod:
If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) = 0 Then GoTo son
eklendi.

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
Cevapla
#6
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
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task