İki data arasına koşullu data eklemek

[Harbidas]

Merhaba arkadaşlar,

http://wupload.eu/site/999b492b2f2f199c90e027874ec4e4db/Test.xlsx linkindeki dosyadaki ilk sütunda yer alan "OFF" verilerinin arasındaki boş hücrelere sırayla 1, 2,3... değerlerini otomatik olarak girebileceğim bir formüle ihtiyacım var.

İlk "OFF" a kadar 1, ikinci "OFF" a kadar 2,... vb.

Yardımlarınızı rica ediyorum.

Teşekkürler,

http://www.dosya.tc/server23/LN1pAQ/Test.xlsx.html

 

[turist]

Dosyanız Upload sitesinden indirilemiyor.
GOOGLE DRIVE, YANDEX DISK, DOSYA.TC veya DOCYA.CO gibi paylaşım sitelerine yükleyerek, linkini verin.

 

[Murat OSMA]

Sn. turist'in uyarısını dikkate alın lütfen.
Linkini verdiğiniz siteden dosyayı indirmek bir hayli zahmetli.
Dosyanızı farklı bir dosya upload sitesine yükleyerek linkini vermeniz; sorunuzun çözümünü hızlandıracaktır.


Verilerinizin A sütununda olduğunu düşünürsek, bu kodları kullanabilirsiniz;

Sub Emre()
    Dim i%
    For i = 1 To Range("A65536").End(3).Row
        If Cells(i, 1) = "" Then
            say = say + 1
            Cells(i, 1) = say
        End If
    Next i
    i = Empty
End Sub

 

[Harbidas]

Merhaba Murat Bey,

Verdiğiniz makroyu çalıştırdım ancak beceremedim sanırım. Linkini güncellediğim excel dosyası üzerinden tekrar bakabilir misiniz rica etsem?

Teşekkür ederim...

 

[Harbidas]

Tekrar merhaba Murat Bey,

Makroyu çalıştırdım... Ancak bütün boşluklardaki değerler artarak gidiyor. Ben ise ilk boş hücreden ilk veriye kadar 1,1,1,1,1..., ilk veriden, ikinci veriye kadar 2,2,2,2,2... şeklinde gitsin istiyorum.

Yardımınız için teşekkür ederim.

 

[Murat OSMA]

Yapmak istediğinizden tam olarak emin olmadığımdan kodları iki farklı seçeneğe göre hazırladım, hangisi sizin için uygunsa onu kullanırsınız;

Sub Emre()
    Dim i%, say%
    For i = 1 To Range("A65536").End(3).Row
        If Cells(i, 2) = "" Then
            say = say + 1
            Cells(i, 2) = say
        End If
    Next i
    i = Empty: say = Empty
End Sub

Sub Emmre()
    Dim i%, say%
    For i = 1 To Range("A65536").End(3).Row
        If Cells(i, 2) = "A" Or Cells(i, 2) = "OFF" Then
            say = say + 1
            Cells(i + 1, 2) = say
                Else
            If Cells(i, 2) = "" Then Cells(i, 2).FillDown
        End If
    Next i
    i = Empty: say = Empty
End Sub

 

[Harbidas]

Size minnettarım Murat Bey, elinize sağlık...

Şimdi bunu tüm sütunlardaki boşlukları bu mantıkla doldurabilecek hale nasıl getirebilirim?

Biliyorum çok oldum ama son bir yardım lütfen...

 

[Murat OSMA]

Yapmak istediğinizi örnek bir dosya üzerinde gösteriniz.

Bu tabloyu şöyle yapmak istiyorum gibi..

 

[Harbidas]

http://www.dosya.tc/server23/SO3cFr/Son.xlsx.html

Bu exceldeki bütün boşlukların, aynı mantıkla dolmasını istiyorum.; Yukarıdan aşağıya, 1,1,1,1,1, OFF,2,2,2,2,2,OFF,3,3,3,3,3... şeklinde.

Çok teşekkür ederim.

 

[Murat OSMA]

Şu kodları bir deneyiniz;

Sub Emre()
    Dim i%, say%, a%
    a = 2: say = 1
10    For i = 2 To Range("A65536").End(3).Row
        If Cells(i, a) = "" Or Cells(i, a) <> "OFF" Then
            Cells(i, a) = say
                ElseIf Cells(i, a) = "OFF" Then
            say = say + 1
            Cells(i + 1, a) = say
        End If
    Next i
    a = a + 1: i = 2
    If Cells(i, a) = "OFF" Then
        say = 0
            Else
        say = 1
    End If
    If a > Cells(1, Columns.Count).End(1).Column Then Exit Sub
    GoTo 10
    i = Empty: say = Empty: a = Empty
End Sub

 

[Harbidas]

Harika...!!!

Elleriniz dert görmesin, çok makbule geçti Murat Bey...

Çok teşekkür ederim...

 

[Murat OSMA]

Rica ederim iyi günler.