Ekdeki dosyayı inceleyip yardımcı olursanız çok sevinirim. Şimdiden teşekkürler.
http://s3.dosya.tc/server5/58gpz6/YAN_YANA_YAZDIRMA.xls.html
http://s3.dosya.tc/server5/58gpz6/YAN_YANA_YAZDIRMA.xls.html
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub yanyana()
Dim d As Object, _
s1 As Worksheet, _
s2 As Worksheet, _
i As Long, _
sat As Long, _
son As Long, _
c, a, x
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Set s1 = Sheets("Sayfa1")
son = s1.Range("A" & Rows.Count).End(3).Row
a = s1.Range("A2:H" & son).Value
For i = LBound(a) To UBound(a)
d(a(i, 3)) = d(a(i, 3)) & "#" & a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) _
& "#" & a(i, 5) & "#" & a(i, 6) & "#" & a(i, 7) & "#" & a(i, 8)
Next i
sat = 2
Set s2 = Sheets("Sayfa2")
s2.Cells.ClearContents
For Each c In d.Keys
x = Split(d.Item(c), "#")
s2.Cells(sat, "A").Resize(, UBound(x) + 1) = x
sat = sat + 1
Next c
Application.ScreenUpdating = True
MsgBox "Bitti..."
End Sub
Merhaba, tebrikler Sayın tasmed.Merhaba,
Ekli dosyada sayfa1' de tablonuzun sayfa2' ye yan yana listeleyen çalışma.
http://s6.dosya.tc/server3/4viopn/YAN_YANA_YAZDIRMA.rar.html
Kod:Option Explicit Sub yanyana() .......... Set d = CreateObject("Scripting.Dictionary") .......... End Sub
Merhaba,
Ekli dosyada sayfa1' de tablonuzun sayfa2' ye yan yana listeleyen çalışma.
http://s6.dosya.tc/server3/4viopn/YAN_YANA_YAZDIRMA.rar.html
Kod:Option Explicit Sub yanyana() Dim d As Object, _ s1 As Worksheet, _ s2 As Worksheet, _ i As Long, _ sat As Long, _ son As Long, _ c, a, x Application.ScreenUpdating = False Set d = CreateObject("Scripting.Dictionary") Set s1 = Sheets("Sayfa1") son = s1.Range("A" & Rows.Count).End(3).Row a = s1.Range("A2:H" & son).Value For i = LBound(a) To UBound(a) d(a(i, 3)) = d(a(i, 3)) & "#" & a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) _ & "#" & a(i, 5) & "#" & a(i, 6) & "#" & a(i, 7) & "#" & a(i, 8) Next i sat = 2 Set s2 = Sheets("Sayfa2") s2.Cells.ClearContents For Each c In d.Keys x = Split(d.Item(c), "#") s2.Cells(sat, "A").Resize(, UBound(x) + 1) = x sat = sat + 1 Next c Application.ScreenUpdating = True MsgBox "Bitti..." End Sub
Merhaba, tebrikler Sayın tasmed.
Anladığım kadarıyla; C sütunu aynı olanları # karakteriyle metin olarak birleştirip, sonra da ayırma yöntemi kullanmışsınız.
Oldukça pratik bir düşünce tarzı olmuş, Scripting_Dictionary kod'u zaten benim için tamamen uzak, bambaşka bir olay.
İnşallah bir gün biz de böyle kodlar yazabiliriz.
Merhaba,
Ekli dosyada sayfa1' de tablonuzun sayfa2' ye yan yana listeleyen çalışma.
http://s6.dosya.tc/server3/4viopn/YAN_YANA_YAZDIRMA.rar.html
Kod:Option Explicit Sub yanyana() Dim d As Object, _ s1 As Worksheet, _ s2 As Worksheet, _ i As Long, _ sat As Long, _ son As Long, _ c, a, x Application.ScreenUpdating = False Set d = CreateObject("Scripting.Dictionary") Set s1 = Sheets("Sayfa1") son = s1.Range("A" & Rows.Count).End(3).Row a = s1.Range("A2:H" & son).Value For i = LBound(a) To UBound(a) d(a(i, 3)) = d(a(i, 3)) & "#" & a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) _ & "#" & a(i, 5) & "#" & a(i, 6) & "#" & a(i, 7) & "#" & a(i, 8) Next i sat = 2 Set s2 = Sheets("Sayfa2") s2.Cells.ClearContents For Each c In d.Keys x = Split(d.Item(c), "#") s2.Cells(sat, "A").Resize(, UBound(x) + 1) = x sat = sat + 1 Next c Application.ScreenUpdating = True MsgBox "Bitti..." End Sub
For i = LBound(a) To UBound(a)
d(a(i, [B][COLOR="Red"]3[/COLOR][/B])) = d(a(i, [B][COLOR="red"]3[/COLOR][/B])) & "#"........
Merhaba.
Koddaki kırmızı 3 sayılarını 4 olarak değiştirince sanırım istediğiniz oluyor.Kod:For i = LBound(a) To UBound(a) d(a(i, [B][COLOR="Red"]3[/COLOR][/B])) = d(a(i, [B][COLOR="red"]3[/COLOR][/B])) & "#"........
Merhaba, tebrikler Sayın tasmed.
Anladığım kadarıyla; C sütunu aynı olanları # karakteriyle metin olarak birleştirip, sonra da ayırma yöntemi kullanmışsınız.
Oldukça pratik bir düşünce tarzı olmuş, Scripting_Dictionary kod'u zaten benim için tamamen uzak, bambaşka bir olay.
İnşallah bir gün biz de böyle kodlar yazabiliriz.
Sy Tasmed kusura bakmazsanız size bu tablo ile alakalı bir soru daha sorabilirmiyim.
Öncelikle ifade etmeliyim ki bu tablo çok işime yaradı elinize sağlık fakat şöyle bir sıkıntım daha var. Aynı matbu belge numarasına sahip birden çok fatura var ama bu matbu belgelerdeki ünvanlar farklı. hazırlamış olduğunuz kod da aynı faturaları yan yana diziyor fakat ben aynı matbu belge numarasına sahip müşterinin verilerini yan yana dizsin yani acaba matbu belge numarası ile müşteri adını eşleştirip ona göre yan yana dizebilirmi.
örnek verecek olursam
matbu belge numarası 155 - firma adı Kınık (yan yana gelen veriler)
matbu belge numarası 155 - firma adı Deva (yan yana gelen veriler)
matbu belge numarası 155 - firma adı Edko (yan yana gelen veriler)
gibi
Kusura bakmayın ben bu hususu ilk göndermiş olduğum ek dosyada belirtmemişim. Bende işlemi yapınca farkettim. Yukarıdaki verdiğim örnekde kodu uyguladığım zaman 155 matbu belge numarasına ait verilerin hepsini yan yana diziyor. Şimdiden çok teşekkür ederim.
d(a(i, 3)) = d(a(i, 3)) & "#" & a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) _
& "#" & a(i, 5) & "#" & a(i, 6) & "#" & a(i, 7) & "#" & a(i, 8)
d(a(i, 3) & "#" & a(i, 4)) = d(a(i, 3) & "#" & a(i, 4)) & "#" & a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) _
& "#" & a(i, 5) & "#" & a(i, 6) & "#" & a(i, 7) & "#" & a(i, 8)
Kod:d(a(i, 3)) = d(a(i, 3)) & "#" & a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) _ & "#" & a(i, 5) & "#" & a(i, 6) & "#" & a(i, 7) & "#" & a(i, 8)
Yukarıdaki kod satırı yerine aşağıdaki kod satırını yazarak deneyiniz.
Kod:d(a(i, 3) & "#" & a(i, 4)) = d(a(i, 3) & "#" & a(i, 4)) & "#" & a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) _ & "#" & a(i, 5) & "#" & a(i, 6) & "#" & a(i, 7) & "#" & a(i, 8)