• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Karşılığı olmayan hücrelerde boşluk oluşturma

K

kıvılcım1982

Katılım
3 Aralık 2008
Mesajlar
42
Excel Vers. ve Dili
2007 Türkçe
Arkadaşlar merhaba,
Aşağıdaki resimde örneğini gönderdiğim gibi excelde aşağı doğru sıralanan domainlerim var. Her ay bazıları siliniyor, yenileri ekleniyor. Benim sizlerden ricam bu domainleri eklerken bazı boş alanlar var. Bunları resmin sağındaki gibi sıralayabilmek. Normalde her defasında boşlukları tek tek elle oluşturuyorum ve bu çok uzun zaman alıyor. Yardımcı olursanız çok sevinirim.

Herkese iyi hafta sonları dilerim.

 
Son düzenleme:
Her sütunu artan yada azalan şekilde sıralayınız.:cool:
 
hocam 4 sütunu birbirleriyle eşleştirecem, aynı içerik olmayan sütun boş kalacak resimde belirttiğim gibi
 
Merhaba,
Aşağıdaki kodu deneyiniz.
Kod: 
Sub kod()
Dim var As Range
Set No = Sheets("Normalde olan")
Set Og = Sheets("Olması Gereken")
Og.Range("A2:D65500").ClearContents
For a = 1 To 4
    For b = 2 To No.Range("A65500").End(3).Row
        If a = 1 Then
            Og.Cells(b, a) = No.Cells(b, a)
        ElseIf No.Cells(b, a) <> "" Then
            Set var = Og.Range(Og.Columns(1), Og.Columns(a - 1)).Find(No.Cells(b, a), , , xlWhole)
            If Not var Is Nothing Then
                Og.Cells(var.Row, a) = No.Cells(b, a)
            Else
                sat = Og.Cells(65500, a).End(3).Row + 1
                Og.Rows(sat).Insert
                Og.Cells(sat, a) = No.Cells(b, a)
            End If
            Set var = Nothing
        End If
    Next
Next
End Sub
 
Çok teşekkürler arkadaşlar, emeğinize sağlık.

@PLİNT hocam 100'e kadar çalışıyor sanırım, benim satır sayısı şuan 700 ama çoğalacak. Daha uzatabilir misiniz acaba
 
kıvılcım1982' Alıntı:
Çok teşekkürler arkadaşlar, emeğinize sağlık.
@PLİNT hocam 100'e kadar çalışıyor sanırım, benim satır sayısı şuan 700 ama çoğalacak. Daha uzatabilir misiniz acaba
Genişletmek için tıkla ...
Yukarıdaki dosya değişti,
Dosyadaki gibi veya aşağıdaki gibi değişiklik yaparak deneyin.
Verilerin; azalıp çoğalma farkı çoksa aşağıdaki gibi daha iyidir.

Kod: 
Private Sub CommandButton1_Click()
Set s1 = [COLOR="Blue"]Sayfa1 'Normalde Olan sayfası[/COLOR]
Set s2 =[COLOR="Blue"] Sayfa2 'Olması gereken sayfası[/COLOR]
[COLOR="Red"]i = 0[/COLOR]
For a = 1 To 4
b = s1.Cells(Rows.Count, a).End(xlUp).Row
[COLOR="Red"]If b > i Then i = b[/COLOR]
s1.Range(s1.Cells(2, a), s1.Cells(b, a)).Sort Key1:=s1.Cells(a, a), Order1:=xlAscending
Next
s = 1
For Each a In s1.Range("a2:d" [COLOR="Red"]& i[/COLOR])
If a.Value <> "" Then
s = s + 1
deg = a.Value
For Each b In s1.Range("a2:d" [COLOR="Red"]& i[/COLOR])
If deg = b.Value Then
s2.Cells(s, b.Column) = b.Value
b.Value = ""
End If
Next
End If
Next
Sayfa2.Select
End Sub
 
@PLİNT hocam gönderdiğiniz dosyadaki sistem çok güzel. Sadece yine bir hata veriyor. Dosyayı size pm attım, bakabilirseniz sevinirim.
 
kıvılcım1982' Alıntı:
@PLİNT hocam gönderdiğiniz dosyadaki sistem çok güzel. Sadece yine bir hata veriyor. Dosyayı size pm attım, bakabilirseniz sevinirim.
Genişletmek için tıkla ...
Merhaba
Eğer gönderdiğiniz dosyadaki gibi sıralama yapıp
bıraktıysa sorun sayfa adlarını tanmlamada olabilir var ama konudaki kodları ekleyip çalıştırınca bir sorun göremedim.
Yukarıda belirtmemişsiniz, Sorun nedir?
 
sizin gönderdiğiniz dosyayı tekrar indirip denedim, bu sefer çalıştı sanırım. Sanırım diyorum çünkü domainleri tek tek kontrol edeyim, biraz sürer. Size tekrar mesaj atarım kontrol edip. Çok teşekkürler ilginiz için.
 
Son düzenleme:
@PLİNT kardeş eline emeğine sağlık, sistem gayet iyi çalışıyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst