Satırları 4'e Tamamlamak.

[Recep İpek]

Hepinize merhaba,

A2 hücresinden başlayan ve 1'den 4'e kadar sayılardan oluşan yaklaşık 100 satırlık bir dizim var.
Ã?rneğin,

A B C
Sayı
1
2
3
4
1
3
4
2
4
..
..
Benim yapmak istediğim bu dizide eksik olan sayıları satır açarak tamamlamak ve eksik sayısı ilgili hücreye yazdırmak.Kısaca bütün satırları 4'e tamamlamak istiyorum

Yardımlarınız için teşekkürler...

 

[Recep İpek]

Sayın Abazya, dediğiniz yöntemi bende biliyorum ama benim elimde 100-150 veri var.Bunların hepsini tek tek yapmak biraz zaman alacaktır.Makro ile çözümünün olduğunu düşünüyorum.Kolay Gelsin.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:1c8d0ea3f6]Sub tamamla()
For a = [a65536].End(3).Row To 2 Step -1
If Cells(a - 1, "a") <> Cells(a, "a") - 1 And Cells(a, "a") <> 1 Then
Cells(a, "a").Insert
Cells(a, "a") = Cells(a + 1, "a") - 1
Call tamamla
End If
Next
End Sub
[/vb:1:1c8d0ea3f6]

 

[abazya]

Pardon. Yanlış anlamışım.

 

[Recep İpek]

Sayın Levenm kodlarınız gayet güzel çalışıyor.
Yalnız 3.dizide çalışmıyor.Diğerlerinde ise 4'e tamamlayıncaya kadar makroyu çalıştırmak gerek :.Teşekkürler.

 

[Levent Menteşoğlu]

3.diziden kastınız nedir? Yukarıdaki kodda küçük bir değişiklik yaptım tekrar denermisiniz.

 

[Recep İpek]

Sn:leventm, dizi derken 1234 sayılarında oluşan verilerimi kastetmiştim.İlk 2 veriyi 4'e tamamlıyor.3.de ise herhangi bir işlem yapmıyor.Diğerlerinde de makro doğru çalışıyor.Fakat son yaptığınız düzeltmede sadece ilk 2 veriyi tamamlıyor.
Kolay Gelsin.

 

[Levent Menteşoğlu]

Evet bunu farkettim yukarıdaki kodu tekrar yeniledim. Bu sefer oldu galiba.

 

[Recep İpek]

Sn.Leventm hatayı buldum galiba.Makro 4 ile bitmeyen dizilerde çalışmıyor.
Ã?rneğin;
1
2
4...Çalışıyor
1
2..Çalışmıyor
1
..
Teşekkürler. :8)

 

[Levent Menteşoğlu]

Birde aşağıdaki gibi denermisiniz.

[vb:1:ae64bbfcb7]Sub tamamla()
son = [a65536].End(3)
If son <> 4 Then [a65536].End(3).Offset(1, 0) = 4
10 deg = Array(4, 1, 2, 3)
c = 2
If [a2] = 1 Then c = 3
For a = [a65536].End(3).Row To c Step -1
If deg(Cells(a, "a") - 1) <> Cells(a - 1, "a") Then
Cells(a, "a").Insert
Cells(a, "a") = deg(Cells(a + 1, "a") - 1)
GoTo 10
End If
Next
End Sub
[/vb:1:ae64bbfcb7]

 

[Recep İpek]

Sn:Leventm bilginize sağlık.Çok teşekkür ederim.
Kolay Gelsin. :hey: