hücre kontrolü;

[abbasonline]

bir dolu bir boş veyahut her ikiside boş, her ikiside dolu, hücrelerdeki

yapmak istediğim gri hücrelerde rakam olduğunda yanındaki hücre boş ise aynı satırda, (A) sütunundaki karşılığı gelen hücredeki rakamları alt alta boşluk vermeden yazdırmak için;

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub SAYILARI_LİSTELE()
    Dim X As Long, Y As Byte, Satır As Long
    
    Application.ScreenUpdating = False
    
    Range("R:R").ClearContents
    
    For X = 3 To Range("A65536").End(3).Row
        For Y = 2 To 16 Step 2
            If Cells(X, Y) <> "" Then
                If Cells(X, Y + 1) = "" Then
                    Satır = Satır + 1
                    Cells(Satır, "R") = Cells(X, "A")
                End If
            End If
        Next
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[abbasonline]

Korhan bey çok teşekkür ederim, güzel olmuş ancak şunu da eklemeyi unutmuşum veyahut düzgün bir şekilde sorumu aktaramadım;

gri hücrede rakam ol duğunda yanındaki dolgu olmayan hücredeki rakam aynı değilsede (A) sütunundaki numarayı yazmasını istiyorum.

Örnek gri hücre 3, dolgu olmayan hücre 1 aynı değil bu satırında (A) sütunundaki numarayı yazmasını istiyorum. 2-1 de olabilir yine aynı yazmasını, 3-2 de olabilir yine aynı yazmasını

sadece iki hücrede boş olduğunda veyahut her iki hücrede de aynı sayı varsa (a) sütunundaki numarayı yazmasın.

 

[abbasonline]

Korhan bey ayrıca fazla mı oluyoruz bilmem ama, (U) sütununda da ağaç, duman, hava, eteş kelimeleri baştan aşağıya yazssa biz bunlarıda,

(A) sütununda almış olduğu rakamın karşılığına gelen (U) sütunundaki kelimeyide (S) sütununa yazdırabilirmiyiz. sonuçta

(R) ve (S) sütunları doldurulacak rakam ve kelime olarak.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub SAYILARI_LİSTELE()
    Dim X As Long, Y As Byte, Satır As Long
    
    Application.ScreenUpdating = False
    
    Sheets("Sayfa3").Select
    Range("A:B").ClearContents
    
    With Sheets("2011")
    
    For X = 3 To .Range("A65536").End(3).Row
        For Y = 2 To 16 Step 2
            If .Cells(X, Y) <> "" Or .Cells(X, Y + 1) <> "" Then
                If .Cells(X, Y) <> .Cells(X, Y + 1) Then
                    Satır = Satır + 1
                    Cells(Satır, "A") = .Cells(X, "A")
                    Cells(Satır, "B") = .Cells(X, "U")
                End If
            End If
        Next
    Next
    
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[abbasonline]

Korhan bey ellerinize sağlık güzel oldu, ancak unutmuşum kusura bakmayın, verilerin olduğu sayfanın ismi( 2011 ) verileri alacağım sayfanın ismide (Sayfa 3) bu şekilde nasıl yapmam gerekli kususra bakmayın kolay gelsin

 

[Korhan Ayhan]

Selamlar,

Son mesajınıza göre lütfen örnek dosya eklermisiniz.

 

[abbasonline]

dosya ekte

 

[Korhan Ayhan]

Selamlar,

#5 nolu mesajımdaki kodu güncelledim. İncelermisiniz.

 

[abbasonline]

Korhan bey teşekkürler, ellerinize sağlık çok güzel olmuş.

 

[abbasonline]

Korhan bey, bilmemek çok kötü bir şey, sayfa 3 de 6 satırdan başlaması için nasıl yapmam gerekli, birde bu verilerin alındığı hücreleri olduğu sayfa 3 de (D6) dan başlayarak yapıştırması mümkünmü.

 

[abbasonline]

Korhan bey, bilmemek çok kötü bir şey, sayfa 3 de 6 satırdan başlaması için nasıl yapmam gerekli, birde bu verilerin alındığı hücreleri olduğu sayfa 3 de (D6) dan başlayarak yapıştırması mümkünmü.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Değişiklik yaptığım bölümleri kırmızı renkle belirttim.

Option Explicit
 
Sub SAYILARI_LİSTELE()
    Dim X As Long, Y As Byte, Satır As Long
    
    Application.ScreenUpdating = False
    
    Sheets("Sayfa3").Select
[COLOR=red]    Range("D:E").ClearContents
    Satır = 5
[/COLOR]    
    With Sheets("2011")
    
    For X = 3 To .Range("A65536").End(3).Row
        For Y = 2 To 16 Step 2
            If .Cells(X, Y) <> "" Or .Cells(X, Y + 1) <> "" Then
                If .Cells(X, Y) <> .Cells(X, Y + 1) Then
                    Satır = Satır + 1
                    Cells(Satır, "[COLOR=red]D[/COLOR]") = .Cells(X, "A")
                    Cells(Satır, "[COLOR=red]E[/COLOR]") = .Cells(X, "U")
                End If
            End If
        Next
    Next
    
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[abbasonline]

Korhan bey teşekkürler.