Döngü Çalıştırmak

[Seyit Tiken]

Selamün Aleyküm,
Arkadaşlar bir döngüyü çalıştırmak istiyorum bir türlü olmuyor, tek taraflı çalışıyor.
Örneğin : A1:C20 arasında her hangi bir hücrede sayısal değer olarak doluysa D1 hücresine "Test" yazsın, A1:C20 arasında boşsa, boş yazsın("" gibi), teşekkür ediyorum, kolay gelsin.

 

[Ömer]

Merhaba Seyit bey,

Sub dongu()
    Dim alan As Range
    Range("D1").ClearContents
    
    For Each alan In Range("A1:C20")
        If alan <> "" And IsNumeric(alan) = True Then
            Range("D1") = "Test"
            Exit Sub
        End If
    Next alan
End Sub

İstediğiniz bu mu?

.

 

[Seyit Tiken]

Ömer bey, çok teşekkür ediyorum, Allah razı olsun.
Şöyle bir sorun var, Change olayına atıyorum döngü tamamlanamıyor, Düğmede sorun yok.

 

[Orion1]

Seyit bey,
Aşağıdaki gibi denermisiniz.

Application.EnableEvents = False
'---Kodlar--
'-----------
'-----------
'Kodlar son
Application.EnableEvents = True

 

[Seyit Tiken]

Sayın Orion1, sizin belirtiğiniz gibi yaptım, gene olmadı, bende Change'de çalışmıyor, Düğmede iyi çalışıyor.

 

[Ömer]

Ömer bey, çok teşekkür ediyorum, Allah razı olsun.
Şöyle bir sorun var, Change olayına atıyorum döngü tamamlanamıyor, Düğmede sorun yok.

Bu şekilde deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim alan As Range
 
    Range("D1").ClearContents
    For Each alan In Range("A1:C20")
        If alan <> "" And IsNumeric(alan) = True Then
            Application.EnableEvents = False
              Range("D1") = "Test"
            Application.EnableEvents = True
            Exit Sub
        End If
    Next alan
 
End Sub

.

 

[Korhan Ayhan]

Merhaba,

Seyit bey döngüsüz aşağıdaki koduda kullanabilirsiniz.

COUNT = BAĞ_DEĞ_SAY

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    Application.EnableEvents = False
    If WorksheetFunction.Count(Range("A1:C20")) > 0 Then
        Range("D1") = "TEST"
    Else
        Range("D1") = ""
    End If
Son: Application.EnableEvents = True
End Sub

 

[Seyit Tiken]

Arkadaşlar çook teşekkür ediyorum, iki kodta mükemmel çalışıyor.