• DİKKAT

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

Satır arası eşitleme boşluk bırakma

Module kopyalayıp çalıştırın.

Sonuçlar Sayfa3 de listelenir.

Kod: 
Sub Eslestir()
 
    Dim S1 As Worksheet, sat As Long, i As Long, c As Range, Adr
 
    Set S1 = Sheets("[COLOR=blue]Sayfa[/COLOR]1")
 
    Application.ScreenUpdating = False
 
    Sheets("[COLOR=red]Sayfa3[/COLOR]").Select
    Range("A2:D" & Rows.Count).Clear
 
    S1.Range("A:B").Copy Range("A1")
 
    sat = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To S1.Cells(Rows.Count, "C").End(xlUp).Row
        With S1.Range("B:B")
            Set c = .Find(S1.Cells(i, "C"), , xlValues, xlWhole)
            If Not c Is Nothing Then
              Adr = c.Address
                Do
                    Cells(c.Row, "C") = S1.Cells(i, "C")
                    Cells(c.Row, "D") = S1.Cells(i, "D")
                  Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            Else
                sat = sat + 1
                Cells(sat, "C") = S1.Cells(i, "C")
                Cells(sat, "D") = S1.Cells(i, "D")
            End If
        End With
    Next i
 
End Sub
.
 
hocam :) ama ama bu 1. listenin aynısını veriyor bana:( hocam şöyle düşünün 1. sınıfta (A SÜTUN) 2000 KİŞİ VAR 2. SINIFTA (B STUNU) 1500 KİŞİ VAR. BU 1500 KİŞİ HEM 1 SINIF VE HEM 2. SINIF OKUYOR. 2000-1500: 500 A SUTUNUNDAN 500 KİŞİNİN YANI BOŞ OLACAK. İSİM VE TC İLE BİRLİKTE. GİBİ.
 
Aynısından kastınız nedir. Sayfa3 de istenen düzende veriler gelmektedir.

Sayfa3 deki verileri silin ve kodu çalıştırın ve sonuçları gözlemleyin.
 
Hocam papatyanın demek istediği, 1. listeyi a'dan z'ye sıraladık sonra 2. listeyi a'dan z'ye sıraladık. Şimdi burda şöyle 1 ayrıntı var. 1. sütunda olupta 2. sütunda olmadığında onun karşısına boş satır atacak. ama yapılan makroda bende inceledim, sadece 1 sütunu olduğu gibi 3. sayfaya çıkartıyor
 
ashes46' Alıntı:
Hocam papatyanın demek istediği, 1. listeyi a'dan z'ye sıraladık sonra 2. listeyi a'dan z'ye sıraladık. Şimdi burda şöyle 1 ayrıntı var. 1. sütunda olupta 2. sütunda olmadığında onun karşısına boş satır atacak. ama yapılan makroda bende inceledim, sadece 1 sütunu olduğu gibi 3. sayfaya çıkartıyor
Genişletmek için tıkla ...

Bu istenilenleri kodlar yapıyor. Eğer amaç ek olarak sıralama yapmak ise;

Application.ScreenUpdating = False

Satırından hemen sonra aşağıdaki kodları ilave etmeniz yeterli olacaktır.

Kod: 
[COLOR=blue]S1.Range("A2:B" & Rows.Count).Sort S1.Range("B2")[/COLOR]
[COLOR=blue]S1.Range("C2:D" & Rows.Count).Sort S1.Range("C2")[/COLOR]
.
 
Hocam ellerinize sağlık çok güzel oldu yaptım :) hiç umudum yoktu sağolun...
 
Hocam son bi sorum daha olcak bu kod sadece a ve b sutunu içinmi geçerli ? Mesela ben a,b,c,d,e,f,g,-----h,ı,i,j,k,l,m, sutunları olarak g ve h sabit deyişmez eşleşecek rakam olmak üzere yapsam aynı kodumu kullanmalıyım yada kodun nerelerinde deyişiklik yapabilirim.
 
Hocam elinize sağlık göndereceğim çalışma gerçeğe çok benzer bir çalışma gönderdiğiniz makro kodları sadece a,b,c,d sutunları için geçerli kodları deyiştirmeye çalıştım yapamadım kırmızı olan kısım deyişmez tc ( h,ı) bi önceki çalışmanın aynısını buna nasıl bir kod yazmalıyız selamlar saygılar...
 

Ekli dosyalar

Olması gereken şablonu Sayfa2 de 4-5 satır manuel girip dosyanızı tekrar eklermisiniz.
 
Hocam yeni bir tane daha örnek yaptım :) 1.liste mavi 2. Liste yeşil.
Bu listeler birbirlerinin içinde harf değişilkiği olsa bile aynı listedir. Yan yana konulmuş 2 liste var. Diğer boş kalan yerlerde dolu fakat manüel olduğu için hızlı yapamadım boş olan yerlere soyadları nufus bilgileri v.s gelecek.ve tıpatıp eşi olması imkansız zaten tc den eşleştirme yapınca otamatik eşleştiriyor. Saygılar..
 

Ekli dosyalar

Dosya eklerken yapıyı bozmadan eklerseniz hem sizin hemde benim zaman kaybını önlemiş olur ve daha hızlı sonuca ulaşırız. Ayrıca başlık satırlarını silmişsiniz bende ona göre yaptım. Başlık satırınız varsa kodları ona göre düzlemeniz gerekir.

Kod: 
Sub Eslestir()
 
    Dim S1 As Worksheet, sat As Long, i As Long, c As Range, Adr
 
    Set S1 = Sheets("Sayfa1")
 
    Application.ScreenUpdating = False
    S1.Range("A1:I" & Rows.Count).Sort S1.Range("I1")
    S1.Range("J1:R" & Rows.Count).Sort S1.Range("J1")
 
    Sheets("Sayfa2").Select
    Range("A1:R" & Rows.Count).Clear
 
    S1.Range("A:I").Copy Range("A1")
 
    sat = Cells(Rows.Count, "H").End(xlUp).Row
    For i = 1 To S1.Cells(Rows.Count, "J").End(xlUp).Row
        With S1.Range("I:I")
            Set c = .Find(S1.Cells(i, "J"), , xlValues, xlWhole)
            If Not c Is Nothing Then
              Adr = c.Address
                Do
                    Cells(c.Row, "J") = S1.Cells(i, "J")
                    S1.Range("K" & i & ":R" & i).Copy Cells(c.Row, "K")
                  Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            Else
                sat = sat + 1
                Cells(sat, "J") = S1.Cells(i, "J")
                S1.Range("K" & i & ":R" & i).Copy Cells(sat, "K")
            End If
        End With
    Next i
 
End Sub
.
 
hocam ne kadar teşekkür etsem azdır. süper oldu :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst