• DİKKAT

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

Kural Tanımlayarak Hücre Birleştirmek

yavuz_yil

yavuz_yil

Katılım
28 Haziran 2013
Mesajlar
147
Excel Vers. ve Dili
Excel 2016/TÜRKÇE
Değerli ustalarım,

Ekli dosyamda bulunan verileri tanımlı bir kural dahilinde birleştirmek mümkün olabilir mi acaba? Detaylar dosyanın içerisinde de anlatılmaktadır.

https://www.dosyaupload.com/dr6m

İlgi ve yardımlarınız için şimdiden teşekkür ederim,

Saygılarımla,
 
Merhaba,

Umarım doğru anlamışımdır.
Birleştirmeyi Sayfa2 de yapar.

Kod: 
Sub Birlestir()
    
    Dim i As Long, S2 As Worksheet, sat As Long
    
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select
    S2.Range("C4:P" & Rows.Count).Clear
 
    sat = 4
    For i = 4 To Cells(Rows.Count, "P").End(xlUp).Row Step 2
        If Cells(i, "P") = Cells(i + 1, "P") Then
            Cells(i, "C").Resize(1, 14).Copy S2.Cells(sat, "C")
            S2.Cells(sat, "F") = Cells(i + 1, "F")
            S2.Cells(sat, "H") = Cells(i + 1, "H")
            S2.Cells(sat, "K") = Cells(i + 1, "K")
            S2.Cells(sat, "N") = Cells(i + 1, "N")
            sat = sat + 1
        Else
            Cells(i, "C").Resize(2, 14).Copy S2.Cells(sat, "C")
            sat = sat + 2
        End If
    Next i
    
    S2.Select
    Columns("E:F").NumberFormat = "m/d/yyyy"
    Columns("N:N").NumberFormat = "[$-F400]h:mm:ss AM/PM"
    
    Application.ScreenUpdating = True
    
End Sub

.
 
Ömer Bey,

Öncelikle ilgi ve yardımınız için teşekkür ederim.Aynen yapmak istediğim şey bu şekilde birleştirme.Lakin listede de gördüğünüz üzere veri çok ve belirttiğim gibi tarihe göre değişik uçuş numaraları mevcut.Verilerin tamamına bunu uygulamak mümkün olabilir mi? Farklı bir sayfada yapması önemli değil yeterki birleştirsin!!

Saygılarımla,
 
Tarihle ilgili bir sınır yada şart koymadım. Tüm verilere uygulanabilir.

.
 
Ömer Bey,

Bu anlamda benim ihtiyacım olan şey uçuş numarasına göre tarihini de baz alarak eşleştirme yaptıktan sonra seferleri birleştirmesi.Eğer yanlış anlamadıysam sizin verdiğiniz kod belirtilen hücreleri birleştiriyor.

Yani şöyle birşey olabilir mi? Örneğin Tarihi aynı ise TK2508 gördüğü her seferin devamına aynı tarihli TK2509 ları yerleştirsin!! Eğer bu yapılabilir ise sadece uçuş numaralarını değiştirerek birleştirmeleri yapabilmek kolay ve istenilen sonucu verecek biçimde olur. Yeri geldiğinde bahsettiğim gibi 15000 uçuş verisini birleştirmem gerekiyor.

Saygılarımla,
 
41 ve 42. satırlar.
Sefere göre doğru fakat tarihleri aynı değil. Bu gibi durumlar için ne yapılması gerekiyor.
 
TK2526 seferinin geliş saati ve TK2527 seferinin gidiş saatinden kaynaklı tarih değişiyor. N sütünundaki saatler geçerli oluyor.
 
Saatlerden dolayı oluyor fakat siz tarih şartı koymak istiyorsunuz. Verdiğim örnekte tarih farklı, bu gibi durumlardaki öneriniz nedir.? Nasıl bir yol izlenmesi gerekiyor.

Şuan kodların yaptığı;
P sütununu ölçüt alıyor. P sütununda seferler sıralı olduğu için, örneğin;

P4 ile P5 i karşılaştırıyor aynı ise birleştiriyor.
P6 ile P7 i karşılaştırıyor aynı ise birleştiriyor.
P8 ile P9 i karşılaştırıyor aynı ise birleştiriyor.
.
.
.

Bu şekilde istenen sonuçları elde ediliyor.

.
 
Ömer' Alıntı:
Saatlerden dolayı oluyor fakat siz tarih şartı koymak istiyorsunuz. Verdiğim örnekte tarih farklı, bu gibi durumlardaki öneriniz nedir.? Nasıl bir yol izlenmesi gerekiyor.

Şuan kodların yaptığı;
P sütununu ölçüt alıyor. P sütununda seferler sıralı olduğu için, örneğin;

P4 ile P5 i karşılaştırıyor aynı ise birleştiriyor.
P6 ile P7 i karşılaştırıyor aynı ise birleştiriyor.
P8 ile P9 i karşılaştırıyor aynı ise birleştiriyor.
.
.
.

Bu şekilde istenen sonuçları elde ediliyor.

.
Genişletmek için tıkla ...

Ömer bey gecikmeli cevap için öncelikle özür dilerim.İnternet arızasından dolayı ancak erişim sağlayabildim.Tarih farklılığı olanları el ile birleştirmede yapabilirim.Çok problem olmaz.Gece yarısını aşan sefer çok fazla denk gelmiyor.Genel itibariyle bana gün içerisindeki seferleri birleştirsin yeter.Ama bunu tek bir komut ile verilerin geneline yapabilirmiyiz?

Saygılarımla,
 
Sefer sayıları birleştirmelerinde P yada O sütununu eşitleyerek gitmeyi düşündüm.
Fakat , aynı tarihte, P5 ile P11 değerleri aynı fakat sefer sayıları tutarsız. Bu veriler hatalı olabilir mi?

Yada P sütunu benim düşündüğüm mantıkta değil mi?

.
 
Ömer Bey,
P5 deki sefer geliş ,P11 deki sefer gidiş seferi.Listede E,G,J,M sütunları geliş seferlerinin verilerini içermekte. F,H,K,N sütunları gidiş seferlerinin verilerini içermekte. O ve P sütunu ise geliş,gidiş her seferin sonunda mutlaka olan uçağın plakası ve tip bilgisini içeriyor.
 
Detaylı deneme yapmadım.
Saat farkından kaynaklı tarihler dışında istenen yapı bu mu?

Kod: 
Sub Ozet_Al()
 
    Dim d As Object, i As Long, j As Byte, s, a1, deg, sut As Byte

    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select

    For i = 4 To Cells(Rows.Count, "C").End(xlUp).Row
        sut = 5
        If IsDate(Cells(i, "F")) = True Then sut = 6
        deg = Cells(i, sut) & "|" & Cells(i, "P")
        If Not d.exists(deg) Then
            ReDim s(3 To [COLOR="Red"]16[/COLOR])
            For j = 3 To [COLOR="red"]16[/COLOR]
                s(j) = Cells(i, j)
            Next j
            d.Add deg, s
        Else
            s = d.Item(deg)
            s(sut) = Cells(i, sut)
            s(sut + 2) = Cells(i, sut + 2)
            s(sut + 5) = Cells(i, sut + 5)
            s(sut + 8) = Cells(i, sut + 8)
            d.Item(deg) = s
        End If
    Next i

    Sheets("Sayfa2").Select
    Cells.Clear
    
    a1 = d.items
    For i = 0 To d.Count - 1
        s = a1(i)
        For j = 3 To [COLOR="red"]16[/COLOR]
            Cells(i + 4, j) = s(j)
        Next j
    Next i
    
    Cells.EntireColumn.AutoFit
    Columns("E:F").NumberFormat = "m/d/yyyy"
    Columns("M:N").NumberFormat = "[$-F400]h:mm:ss AM/PM"

    Application.ScreenUpdating = True

End Sub

.
 
Ömer Bey,

Elinize emeğinize sağlık.Gerçekten size minnettarım.

Son bir soru daha sorsam!! Mevcut verilere Z sütununa kadar ilave veriler koysam onları da aynı şekilde birleştirme işlemine dahil eder mi yoksa hata verir mi?
 
Kodlardaki 3 to 16 sütun indislerini ifade eder. Yani C ile P sütunu arası anlamına gelir. Z nin indisi 26. sütundur. Diğer mesajda kırmızı ile işaretledim.
16 gördüğünüz yerlere 26 yazın.
Verileri bu şekilde birleştirebilirsiniz. Yalnız ilave olarak sütunlarda birleştirme olacaksa, Else komutundan sonraki;

s(sut + 8) = Cells(i, sut + 8) gibi + 8 yerine doğru sütun numaralarını yazıp ilave edebilirsiniz.

.
 
Ömer' Alıntı:
Kodlardaki 3 to 16 sütun indislerini ifade eder. Yani C ile P sütunu arası anlamına gelir. Z nin indisi 26. sütundur. Diğer mesajda kırmızı ile işaretledim.
16 gördüğünüz yerlere 26 yazın.
Verileri bu şekilde birleştirebilirsiniz. Yalnız ilave olarak sütunlarda birleştirme olacaksa, Else komutundan sonraki;

s(sut + 8) = Cells(i, sut + 8) gibi + 8 yerine doğru sütun numaralarını yazıp ilave edebilirsiniz.

.
Genişletmek için tıkla ...

Ömer Bey tekrar tekrar teşekkürlerimi sunarım.Sadece anlayamadığım nokta aşağıdaki düzenlemeyi nasıl yapacağım.Mesela ben Q,R,S sütunlarına saat verisi ilave etsem.Birleştirirken bunların numarasını 8 yerine ne yazmalıyım ki birleştrime yapsın?

s(sut + 8) = Cells(i, sut + 8) gibi + 8 yerine doğru sütun numaralarını yazıp ilave edebilirsiniz.
 
Ömer bey,

Deneme yaptım ama genede ifade etmek istediğinizi anlayamadım ve başaramadım.Mümkün ise son soruma da yardımcı olursanız minnettar kalırım...

Saygılarımla,
 
Yeni veri düzenini gösteren dosya eklemenizde fayda var.

İstediğiniz bu mu?

Kod: 
Sub Ozet_Al()
 
    Dim d As Object, i As Long, j As Byte, s, a1, deg, sut As Byte

    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select

    For i = 4 To Cells(Rows.Count, "C").End(xlUp).Row
        sut = 5
        If IsDate(Cells(i, "F")) = True Then sut = 6
        deg = Cells(i, sut) & "|" & Cells(i, "P")
        If Not d.exists(deg) Then
            ReDim s(3 To 26)
            For j = 3 To 26
                s(j) = Cells(i, j)
            Next j
            d.Add deg, s
        Else
            s = d.Item(deg)
            s(sut) = Cells(i, sut)
            s(sut + 2) = Cells(i, sut + 2)
            s(sut + 5) = Cells(i, sut + 5)
            s(sut + 8) = Cells(i, sut + 8)
            s(sut + 11) = Cells(i, sut + 11)
            s(sut + 13) = Cells(i, sut + 13)
            d.Item(deg) = s
        End If
    Next i

    Sheets("Sayfa2").Select
    Cells.Clear
    
    a1 = d.items
    For i = 0 To d.Count - 1
        s = a1(i)
        For j = 3 To 26
            Cells(i + 4, j) = s(j)
        Next j
    Next i
    
    Cells.EntireColumn.AutoFit
    Columns("E:F").NumberFormat = "m/d/yyyy"
    Range("M:N,Q:S").NumberFormat = "[$-F400]h:mm:ss AM/PM"

    Application.ScreenUpdating = True

End Sub


.
 
İstediğiniz bu mu?

Kod: 
Sub Ozet_Al()
 
    Dim d As Object, i As Long, j As Byte, s, a1, deg, sut As Byte

    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select

    For i = 4 To Cells(Rows.Count, "C").End(xlUp).Row
        sut = 5
        If IsDate(Cells(i, "F")) = True Then sut = 6
        deg = Cells(i, sut) & "|" & Cells(i, "P")
        If Not d.exists(deg) Then
            ReDim s(3 To 28)
            For j = 3 To 28
                s(j) = Cells(i, j)
            Next j
            d.Add deg, s
        Else
            s = d.Item(deg)
            s(sut) = Cells(i, sut)
            s(sut + 2) = Cells(i, sut + 2)
            s(sut + 5) = Cells(i, sut + 5)
            s(sut + 8) = Cells(i, sut + 8)
            s(sut + 12) = Cells(i, sut + 12)
            s(sut + 13) = Cells(i, sut + 13)
            s(sut + 14) = Cells(i, sut + 14)
            s(sut + 19) = Cells(i, sut + 19)
            s(sut + 20) = Cells(i, sut + 20)
            s(sut + 21) = Cells(i, sut + 21)
            s(sut + 22) = Cells(i, sut + 22)
            d.Item(deg) = s
        End If
    Next i

    Sheets("Sayfa2").Select
    Cells.Clear
    
    a1 = d.items
    For i = 0 To d.Count - 1
        s = a1(i)
        For j = 3 To 28
            Cells(i + 4, j) = s(j)
        Next j
    Next i
    
    Cells.EntireColumn.AutoFit
    Columns("E:F").NumberFormat = "m/d/yyyy"
    Range("M:N,Q:T").NumberFormat = "[$-F400]h:mm:ss AM/PM"

    Application.ScreenUpdating = True

End Sub


.
 
Çok teşekkür ederim.Sizi uğraştırdım.Aynen tam olarak istediğim bunu yapmaktı!!
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst