Skip to main content

AccessTr.neT


Clearcontents Sınırlaması

Clearcontents Sınırlaması

Çözüldü #1
Kolay gelsin arkadaşlar...

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo 10
    Application.EnableEvents = False
    Range("A7:A15000").ClearContents
    No = 1
    Select Case Target.Column
        Case 1 To 6
        For X = 7 To 15000
            If Cells(X, 2) <> "" And Cells(X, 2) <> "" Then
                Cells(X, 1) = No
                No = No + 1
            End If
        Next
    End Select
10  Application.EnableEvents = True
End Sub

Yukarıdaki kod ile Excel de otomatik satır numarası verilmekte. Ancak Range("A7:A15000").ClearContents  olarak satır sınırlamasını 15000 olarak sınırlandırdım. Son satırdaki 15000'den küçük yani satır sayısı Örneğin:2845 olduğunda otomatik olarak sayı vermiyor. 15000 sınırlandırmasını Range("A7:A").ClearContents yapıncada otomatik sayı vermiyor. Sınırlandırma olmadan otomatik sayı vermeyi nasıl halledebilir.

Saygılar....!
.rar 6-Haziran-2.rar (Dosya Boyutu: 61,8 KB | İndirme Sayısı: 2)
Son Düzenleme: 13/09/2023, 17:27, Düzenleyen: HORZUM.
Cevapla
#2
(13/09/2023, 15:24)HORZUM yazdı: Cells(X, 2) <> "" And Cells(X, 2) <> ""

Merhaba.
Öncelikle yukarda 2 kere yazılmış aynı kriter.Sonrasında ise örnek eklemenizde fayda var sizin için.
Cevapla
#3
Bu arada kodun daha hızlı olması için alttaki kodlardan birini kullanabilirsiniz.
Tabii normali olan ilk kod.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr(), dizi
    Const sonSatir As Long = 15000
    
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A7:F" & sonSatir)) Is Nothing Then
        Range("A7:A" & sonSatir).ClearContents
        On Error GoTo 10
        dizi = Range("B7:B" & sonSatir).Value2
        No = 1
            ReDim arr(1 To sonSatir, 1 To 1)
            For x = 1 To UBound(dizi)
                If dizi(x, 1) <> "" Then
                    arr(x, 1) = No
                    No = No + 1
                End If
            Next
        Range("A7").Resize(UBound(arr), 1).Value = arr
    End If
    
    Application.EnableEvents = True
    Exit Sub
10
    Range("A7:A" & sonSatir).ClearContents 'Hata durumunda tümünü silmek icin
    Application.EnableEvents = True
    MsgBox "Hata oldu", vbCritical, "Hata"
End Sub

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr(), dizi
    Const sonSatir As Long = 15000
  
    Application.EnableEvents = False
    Range("A7:A" & sonSatir).ClearContents
    On Error GoTo 10
    dizi = Range("B7:B" & sonSatir).Value2
    No = 1
    Select Case Target.Column
        Case 1 To 6
        ReDim arr(1 To sonSatir, 1 To 1)
        For x = 1 To UBound(dizi)
            If dizi(x, 1) <> "" Then
                arr(x, 1) = No
                No = No + 1
            End If
        Next
    End Select
    Range("A7").Resize(UBound(arr), 1).Value = arr
    Application.EnableEvents = True
    Exit Sub
10
    Range("A7:A" & sonSatir).ClearContents 'Hata durumunda tümünü silmek icin
    Application.EnableEvents = True
    MsgBox "Hata oldu", vbCritical, "Hata"
End Sub

Cevapla
#4
(13/09/2023, 17:58)feraz yazdı: Bu arada kodun daha hızlı olması için alttaki kodlardan birini kullanabilirsiniz.
Tabii normali olan ilk kod.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr(), dizi
    Const sonSatir As Long = 15000
   
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A7:F" & sonSatir)) Is Nothing Then
        Range("A7:A" & sonSatir).ClearContents
        On Error GoTo 10
        dizi = Range("B7:B" & sonSatir).Value2
        No = 1
            ReDim arr(1 To sonSatir, 1 To 1)
            For x = 1 To UBound(dizi)
                If dizi(x, 1) <> "" Then
                    arr(x, 1) = No
                    No = No + 1
                End If
            Next
        Range("A7").Resize(UBound(arr), 1).Value = arr
    End If
   
    Application.EnableEvents = True
    Exit Sub
10
    Range("A7:A" & sonSatir).ClearContents 'Hata durumunda tümünü silmek icin
    Application.EnableEvents = True
    MsgBox "Hata oldu", vbCritical, "Hata"
End Sub

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr(), dizi
    Const sonSatir As Long = 15000
 
    Application.EnableEvents = False
    Range("A7:A" & sonSatir).ClearContents
    On Error GoTo 10
    dizi = Range("B7:B" & sonSatir).Value2
    No = 1
    Select Case Target.Column
        Case 1 To 6
        ReDim arr(1 To sonSatir, 1 To 1)
        For x = 1 To UBound(dizi)
            If dizi(x, 1) <> "" Then
                arr(x, 1) = No
                No = No + 1
            End If
        Next
    End Select
    Range("A7").Resize(UBound(arr), 1).Value = arr
    Application.EnableEvents = True
    Exit Sub
10
    Range("A7:A" & sonSatir).ClearContents 'Hata durumunda tümünü silmek icin
    Application.EnableEvents = True
    MsgBox "Hata oldu", vbCritical, "Hata"
End Sub


Teşekkür ederim feraz Hocam...

1. Kod ve 2. Kod Range("A7:A" & sonSatir).ClearContents kısmında hata veriyor. Range("A7" & sonSatir).ClearContents olarak düzeltince de en son satırdaki bilgileri siliyor
Son Düzenleme: 14/09/2023, 12:48, Düzenleyen: HORZUM.
Cevapla
#5
Rica ederim.Hatayı görmek için öncedende dediğim gibi ek eklemeniz faydanıza.
Cevapla
#6
(14/09/2023, 17:35)feraz yazdı: Rica ederim.Hatayı görmek için öncedende dediğim gibi ek eklemeniz faydanıza.
.rar 6-Haziran-2.rar (Dosya Boyutu: 61,98 KB | İndirme Sayısı: 2)
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task