İlk boşluğa yaz

[soykan]

Aşağıdaki gibi bir datam var. A ve B sütunundan oluşuyor.

ahmet 05.01.2011
ahmet 06.01.2011
ahmet
ahmet
ahmet
ahmet d
mehmet
mehmet
mehmet
mehmet d
soykan 08.01.2011
soykan
soykan
soykan d
Buraya yukarıda görüldüğü gibi tarihlerin altına d yazdırmak istiyorum. Aşağıdaki makro ile yaptım. Ancak istediğim il isim değiştiğindeki boşluğa d yi yazması bense isim değiştiğinde yazdırbildim nasıl yapabilirim. Benim yazdığım makro aşağıda:
Sub islm()
Dim a As Integer

For a = 1 To [a50000].End(3).Row
If Cells(a, "b") = Empty And Cells(a, "a") <> Cells(a + 1, "a") Then

Cells(a, "b").Value = "d"
End If
Next a
End Sub

 

[soykan]

k yı yazmayı unutmuşum anlam eksikliği olmuş yazıyı düzelttim.

Ancak istediğim ilk isim değiştiğindeki boşluğa d yi yazması bense isim değiştiğinde yazdırbildim nasıl yapabilirim. Benim yazdığım makro aşağıda:

 

[Necdet]

tarihlerin altına d yazdırmak istiyorum. Aşağıdaki makro ile yaptım. Ancak istediğim il isim değiştiğindeki boşluğa d yi yazması bense isim değiştiğinde yazdırbildim nasıl yapabilirim. Benim yazdığım makro aşağıda:

Bi anlasam yardımcı olmaya çalışacam ama, nerdeeeeeeee

Anladıysam sorunuzu arap olayım.

Konu başlığından farklı, soruyu okuyunca farklı şeyler anlıyorum sorunuzdan. Üzerinde düşününce hepten hiç bir şey anlamıyorum.

Sorunuzu örnek dosya ile ve olması gerekeni elinizle renkli olarak yazınız ki tam olarak anlaşabilelim.

 

[soykan]

Dosya ektedir. Teşekkürler.

 

[Ömer]

Dosya ektedir. Teşekkürler.

Bu şekilde deneyin.

Sub dEkle()
 
    Dim i As Long, deg As Variant
 
    Application.ScreenUpdating = False
 
    Range("B:B").Replace "[COLOR=blue]d[/COLOR]", ""
 
    With CreateObject("Scripting.Dictionary")
        For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
            If Cells(i, "B") = Empty Then
                deg = Cells(i, "A")
                If .exists(deg) = False Then
                    .Add deg, Nothing
                    Cells(i, "B") = "[COLOR=blue]d[/COLOR]"
                End If
            End If
        Next i
    End With
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[soykan]

Çok Teşekkürler

 

[soykan]

Makro çözümünüzü aldım uyguladım. Mükemmel.
Ancak burada daha önce uygulamadığım
With CreateObject("Scripting.Dictionary")

If .exists(deg) = False Then
.Add deg, Nothing
VBA kodları var bunları açıklayabilir misiniz? Ki ben de daha sonra farklı makro larda kullanabileyim.
Zahmetleriniz için teşekkürler.

 

[Ömer]

Linki inceleyiniz.

Scripting.Dictionary Nesnesi,

.