• DİKKAT

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

Değişken satırları tek satırda birleştirme

  • Konbuyu başlatan Konbuyu başlatan moguz4
  • Başlangıç tarihi Başlangıç tarihi
Katılım
15 Nisan 2007
Mesajlar
3
Excel Vers. ve Dili
2003 TR
Merhaba. Arkadaşlar ekte göndermiş olduğum örnekte Bilgileri txt dosyasından exele aktarıp text to column ile sutunlara dönüştürüyorum. Daha sonra her bir tarih başlığında değişken olan birden fazla satırı tek satırda birleştirmek istiyorum. Macro konusunda hiç bigim yok. Yardımcı olabilirseniz sevinirim. Teşekkür ederim.
 

Ekli dosyalar

Birleştirme işlemini bir örnekle açıklayın.
 
Örnekte A,B ve C kolonları tek satırdan oluşuyor. Fakat D sütununda 2 satır ve E sütununda 5 satırdan oluşan içerik bilgilerini tek bir satır içerisinde toplamak istiyorum. ek'te açıklamaya çalıştım.
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:
Option Explicit
 
Sub DÜZENLE()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Y As Long
    Dim Satır As Long, Son_Satır As Long
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Satır = 2
 
    S2.Range("A2:E" & Rows.Count).ClearContents
 
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        S2.Range("A" & Satır & ":C" & Satır).Value = S1.Range("A" & X & ":C" & X).Value
        If S1.Cells(X, "A").End(4).Row = Rows.Count Then
            Son_Satır = S1.Cells(Rows.Count, "E").End(3).Row
        Else
            Son_Satır = S1.Cells(X, "A").End(4).Row - 1
        End If
 
        For Y = X To Son_Satır
            If S1.Cells(Y, "D") <> "" Or S1.Cells(Y, "E") <> "" Then
                S2.Cells(Satır, "D") = IIf(S2.Cells(Satır, "D") = "", S1.Cells(Y, "D"), S2.Cells(Satır, "D") & Chr(10) & S1.Cells(Y, "D"))
                S2.Cells(Satır, "E") = IIf(S2.Cells(Satır, "E") = "", S1.Cells(Y, "E"), S2.Cells(Satır, "E") & Chr(10) & S1.Cells(Y, "E"))
            End If
        Next
        Satır = Satır + 1
        X = Y - 1
    Next
 
    S2.Select
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Ekli dosyalar

Üstadım emeğinize ve elinize sağlık. Çok teşekkür ediyorum.
 
benzer yardım talebi

benimde buna benzer bir sorunum var. ekteki dosyada fatura detaylı listesi var ve bu liste çok uzun verileri içeriyor. istediğim özetle şudur. aynı fatura numarasında aynı stok kodlu ve aynı fiyatta olan satırların birleştirilerek yazılması. yardımcı olabilirseniz sevinirim.
 

Ekli dosyalar

Geri
Üst