Bir sütundaki veriyi yan yana satırlara getirme

S

SKBR

Katılım
4 Aralık 2019
Mesajlar
112
Excel Vers. ve Dili
Excel 2013 Türkçe
Korhan Ayhan' Alıntı:
Örnek ekleyerek açıklarsanız daha faydalı olacaktır.
Genişletmek için tıkla ...
https://we.tl/t-kC9GJpWwIJ

İstediğim örnek ekteki gibi. Yani iki hücredeki sütun birleşecek. Şöyle bir kod ile birleşme sağlanıyor ancak sizin yukarıdaki vermiş olduğunuz kodlar ile birleşimi nasıl sağalayacağımı bulamadım.



Kod: 
For i = 1 To 100
Cells(i, 10).Value = Cells(i, 1).Text & " - " & Cells(i, 3).Text
Next i
i = ""
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,276
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
İlk paylaştığınız dosyada görüntü aşağıdaki gibiydi. Buna göre tabloya ne eklemek istiyorsunuz?

Buna göre örnek paylaşırsanız daha sağlıklı olacaktır.

217796
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,276
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
İnceleyiniz.

we.tl

1589282892124.png

1 file sent via WeTransfer, the simplest way to send your files around the world
we.tl we.tl
 
S

SKBR

Katılım
4 Aralık 2019
Mesajlar
112
Excel Vers. ve Dili
Excel 2013 Türkçe
Korhan Ayhan' Alıntı:
İnceleyiniz.

we.tl

1589282892124.png

1 file sent via WeTransfer, the simplest way to send your files around the world
we.tl we.tl
Genişletmek için tıkla ...
https://we.tl/t-9SrXreE3hH

Ekledim Korhan Bey. "İsim" sütunundaki verilerin ilgili Sku ile aynı hücrede görünmesini istiyordum. Eğer bu şekilde zor olursa "Toplam Satış" satırları gibi "İsim" adında bir satır ekleyip ilgili skuların altına ilgili isimleri de yazdırabiliriz. Hangisi daha kolayınıza gelirse.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,276
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++: 
Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, Dizi As Object, Veri As Variant, Aranan As String
    Dim Son As Long, X As Long, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
    Dizi.CompareMode = vbTextCompare
    
    Range("F:XFD").Clear
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    Veri = S1.Range("A2:D" & Son).Value
    
    ReDim Liste(1 To 3, 1 To S1.Columns.Count)
    
    For X = LBound(Veri) To UBound(Veri)
        Aranan = Veri(X, 1) & Chr(10) & Veri(X, 4)
        If Not Dizi.Exists(Aranan) Then
            Say = Say + 1
            Dizi.Add Aranan, Say
            Liste(1, Say) = Aranan
            Liste(2, Say) = Veri(X, 2)
            Liste(3, Say) = Veri(X, 3)
        Else
            Liste(2, Dizi.Item(Aranan)) = Liste(2, Dizi.Item(Aranan)) + Veri(X, 2)
            Liste(3, Dizi.Item(Aranan)) = Liste(3, Dizi.Item(Aranan)) + Veri(X, 3)
        End If
    Next
    
    If Say > 0 Then
        S1.Range("G1").Resize(3, Say) = Liste
        S1.Range("G1").Resize(1, Say).Font.Bold = True
        S1.Range("G1").Resize(1, Say).HorizontalAlignment = xlCenter
        S1.Range("F2:F3").Value = Application.Transpose(Array("TOPLAM SATIŞ", "ŞUBE SAYISI"))
        S1.Range("F2:F3").Font.Bold = True
        S1.Columns.AutoFit
        S1.Rows.AutoFit
    End If

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
S

SKBR

Katılım
4 Aralık 2019
Mesajlar
112
Excel Vers. ve Dili
Excel 2013 Türkçe
Korhan Ayhan' Alıntı:
Deneyiniz.

C++: 
Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, Dizi As Object, Veri As Variant, Aranan As String
    Dim Son As Long, X As Long, Say As Long, Zaman As Double
   
    Zaman = Timer
   
    Set S1 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
    Dizi.CompareMode = vbTextCompare
   
    Range("F:XFD").Clear
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    Veri = S1.Range("A2:D" & Son).Value
   
    ReDim Liste(1 To 3, 1 To S1.Columns.Count)
   
    For X = LBound(Veri) To UBound(Veri)
        Aranan = Veri(X, 1) & Chr(10) & Veri(X, 4)
        If Not Dizi.Exists(Aranan) Then
            Say = Say + 1
            Dizi.Add Aranan, Say
            Liste(1, Say) = Aranan
            Liste(2, Say) = Veri(X, 2)
            Liste(3, Say) = Veri(X, 3)
        Else
            Liste(2, Dizi.Item(Aranan)) = Liste(2, Dizi.Item(Aranan)) + Veri(X, 2)
            Liste(3, Dizi.Item(Aranan)) = Liste(3, Dizi.Item(Aranan)) + Veri(X, 3)
        End If
    Next
   
    If Say > 0 Then
        S1.Range("G1").Resize(3, Say) = Liste
        S1.Range("G1").Resize(1, Say).Font.Bold = True
        S1.Range("G1").Resize(1, Say).HorizontalAlignment = xlCenter
        S1.Range("F2:F3").Value = Application.Transpose(Array("TOPLAM SATIŞ", "ŞUBE SAYISI"))
        S1.Range("F2:F3").Font.Bold = True
        S1.Columns.AutoFit
        S1.Rows.AutoFit
    End If

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Genişletmek için tıkla ...
Korhan Bey, teşekkür ederim örnek dosya üzerinde çalışıyor. Şimdi bunu asıl dosyama uyarlamam gerekiyor. İnternetten biraz araştırdım ancak çok sağlıklı bilgiler edinemedim. Çok vaktinizi almayacaksa eğer anlamak istiyorum, kısa kısa kodların anlamları ile ilgili bilgi vermeniz mümkün müdür?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,276
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Satır aralarına küçük açıklamalar ekledim. Umarım faydası olur.

C++: 
Option Explicit

Sub Analiz()
    Rem Makro içinde kullanılacak değişkenleri tanımlıyoruz.
    Dim S1 As Worksheet, Dizi As Object, Veri As Variant, Aranan As String
    Dim Son As Long, X As Long, Say As Long, Zaman As Double
  
    Rem Makronun çalışma süresini hesaplamak için bir zamanlayıcı çalıştırıyoruz.
    Zaman = Timer
  
    Rem Kod içinde sayfa adını uzun uzun yazmamak için kısa bir değişkene tanımlıyoruz.
    Set S1 = Sheets("Sayfa1")
  
    Rem Benzersiz liste oluşturmak için Dictionary kütüphanesini tanımlıyoruz ve Text modunda çalışmasını sağlıyoruz.
    Set Dizi = CreateObject("Scripting.Dictionary")
    Dizi.CompareMode = vbTextCompare
  
    Rem Sonucun yazılacağı hücre aralığını temizliyoruz.
    Range("F:XFD").Clear
  
    Rem A sütunundaki son dolu hücresin satır numarasını buluyoruz.
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
  
    Rem İşlemlerin son hızla yapılması için excel hücrelerini hafızaya yüklüyoruz.
    Veri = S1.Range("A2:D" & Son).Value
  
    Rem Sonuçları listelemek için 3 satırlı ve n sütunlu bir dizi tanımlıyoruz.
    Rem Bu dizi bizim sorgumuz sonucunda koşula uyan kayıtları biriktireceğimiz dizidir.
    ReDim Liste(1 To 3, 1 To S1.Columns.Count)
  
    Rem Hafızaya aldığımız excel hücrelerini döngüye alıyoruz. Bu döngü ile satır satır sorgumuzu işleteceğiz.
    For X = LBound(Veri) To UBound(Veri)
        Rem Benzersiz liste için sayfadaki A ve D sütunlarındaki verileri birleştiriyoruz. Bu bizim anahtar verimiz olacak.
        Aranan = Veri(X, 1) & Chr(10) & Veri(X, 4)
        Rem Anahtar verimizin Dictionary kütüphanesinde olmadığını sorguluyoruz. Buradaki Not ifadesi olumsuzluk anlamındadır. Yani anahtarımız dizide yoksa diziye yükle diyoruz.
        If Not Dizi.Exists(Aranan) Then
            Rem Anahtar verimizin diziye yüklemek için 1'den başlayan bir sayaç oluşturuyoruz.
            Rem Bu sayaç daha sonra bizim çok işimize yarayacak.
            Rem Bir nevi benzersiz bir ID numarası olarak kullanılacaktır.
            Say = Say + 1
            Rem Anahtar verimizi diziye yüklüyoruz.
            Dizi.Add Aranan, Say
            Rem Benzersiz anahtar verimize ait hafızaya aldığımız excel hücrelerindeki verileri sonuç dizimize sütun bazında yüklüyoruz.
            Rem Burada Say isimli sayaç aynı zamanda sütun olarak kullanılmıştır.
            Liste(1, Say) = Aranan
            Rem Sayısal değerler sonuç dizisine yükleniyor.
            Liste(2, Say) = Veri(X, 2)
            Liste(3, Say) = Veri(X, 3)
        Else
            Rem Anahtar verimiz döngü sırasında tekrar ediyorsa yani bu durumda mükerrer oluyor, makromuz bu bölüme geçecektir.
            Rem Anahtar verimiz döngü sırasında tekrar ediyorsa yani bu durumda mükerrer oluyor, makromuz bu bölüme geçecektir.
            Rem Örneklersek; sayfadaki 2. ve 3. satırların A-D sütunları aynı anahtarı içeriyor. Else satırından önce excelin 2. satırı benzersiz olduğu için diziye ekleniyor.
            Rem Else satırından sonra ise excelin 3. satırı işleme alınıyor. Çünkü 3. satır 2. satırın anahtar bakımından tekrarıdır.
            Rem Else satırından önce sonuç dizisine alınan sayısal değerlerin üzerine 3. satırdaki değerleri ekleyerek toplama işlemi yapıyoruz.
            Rem Buradaki ince nokta ise anahtar verimizi Dictionary kütüphanesine yüklerken kullandığımız sayaç değeridir.
            Rem Bu değeri kullanarak sonuç dizisindeki yerini tespit  ediyoruz ve doğru eşleşmeyi sağlıyoruz.
            Liste(2, Dizi.Item(Aranan)) = Liste(2, Dizi.Item(Aranan)) + Veri(X, 2)
            Liste(3, Dizi.Item(Aranan)) = Liste(3, Dizi.Item(Aranan)) + Veri(X, 3)
        End If
    Next
    Rem Döngü sonu...
  
    Rem Eğer sayacımız sıfırdan büyükse bir sonuç dizisi oluşmuştur. Bu oluşan sonuç listesini excelde bir alana yazdıracağız.
    If Say > 0 Then
        Rem Sonuç listemizi G1 hücresinden itibaren sayfamıza yazdırıyoruz. Sonuç listemiz 3 satırlı ve Say değişkenindeki kadar sütunlu olacaktır.
        S1.Range("G1").Resize(3, Say) = Liste
        Rem G1 ve sağındaki listelenen sütunları kalınlaştırıyoruz.
        S1.Range("G1").Resize(1, Say).Font.Bold = True
        Rem G1 ve sağındaki listelenen sütunları ortalıyoruz.
        S1.Range("G1").Resize(1, Say).HorizontalAlignment = xlCenter
        Rem F2-F3 hücrelerine başlıkları yazdırıyoruz.
        S1.Range("F2:F3").Value = Application.Transpose(Array("TOPLAM SATIŞ", "ŞUBE SAYISI"))
        Rem F2-F3 hücrelerini kalınlaştırıyoruz.
        S1.Range("F2:F3").Font.Bold = True
        Rem Sayfadaki tüm sütunların genişliklerini ayarlıyoruz.
        S1.Columns.AutoFit
        Rem Sayfadaki tüm satırların yüksekliklerini ayarlıyoruz.
        S1.Rows.AutoFit
    End If

    Rem makronun tamamlandığına dair kullanıcıya bilgilendirme mesajı veriyoruz.
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
S

SKBR

Katılım
4 Aralık 2019
Mesajlar
112
Excel Vers. ve Dili
Excel 2013 Türkçe
Korhan Ayhan' Alıntı:
Satır aralarına küçük açıklamalar ekledim. Umarım faydası olur.

C++: 
Option Explicit

Sub Analiz()
    Rem Makro içinde kullanılacak değişkenleri tanımlıyoruz.
    Dim S1 As Worksheet, Dizi As Object, Veri As Variant, Aranan As String
    Dim Son As Long, X As Long, Say As Long, Zaman As Double
 
    Rem Makronun çalışma süresini hesaplamak için bir zamanlayıcı çalıştırıyoruz.
    Zaman = Timer
 
    Rem Kod içinde sayfa adını uzun uzun yazmamak için kısa bir değişkene tanımlıyoruz.
    Set S1 = Sheets("Sayfa1")
 
    Rem Benzersiz liste oluşturmak için Dictionary kütüphanesini tanımlıyoruz ve Text modunda çalışmasını sağlıyoruz.
    Set Dizi = CreateObject("Scripting.Dictionary")
    Dizi.CompareMode = vbTextCompare
 
    Rem Sonucun yazılacağı hücre aralığını temizliyoruz.
    Range("F:XFD").Clear
 
    Rem A sütunundaki son dolu hücresin satır numarasını buluyoruz.
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
 
    Rem İşlemlerin son hızla yapılması için excel hücrelerini hafızaya yüklüyoruz.
    Veri = S1.Range("A2:D" & Son).Value
 
    Rem Sonuçları listelemek için 3 satırlı ve n sütunlu bir dizi tanımlıyoruz.
    Rem Bu dizi bizim sorgumuz sonucunda koşula uyan kayıtları biriktireceğimiz dizidir.
    ReDim Liste(1 To 3, 1 To S1.Columns.Count)
 
    Rem Hafızaya aldığımız excel hücrelerini döngüye alıyoruz. Bu döngü ile satır satır sorgumuzu işleteceğiz.
    For X = LBound(Veri) To UBound(Veri)
        Rem Benzersiz liste için sayfadaki A ve D sütunlarındaki verileri birleştiriyoruz. Bu bizim anahtar verimiz olacak.
        Aranan = Veri(X, 1) & Chr(10) & Veri(X, 4)
        Rem Anahtar verimizin Dictionary kütüphanesinde olmadığını sorguluyoruz. Buradaki Not ifadesi olumsuzluk anlamındadır. Yani anahtarımız dizide yoksa diziye yükle diyoruz.
        If Not Dizi.Exists(Aranan) Then
            Rem Anahtar verimizin diziye yüklemek için 1'den başlayan bir sayaç oluşturuyoruz.
            Rem Bu sayaç daha sonra bizim çok işimize yarayacak.
            Rem Bir nevi benzersiz bir ID numarası olarak kullanılacaktır.
            Say = Say + 1
            Rem Anahtar verimizi diziye yüklüyoruz.
            Dizi.Add Aranan, Say
            Rem Benzersiz anahtar verimize ait hafızaya aldığımız excel hücrelerindeki verileri sonuç dizimize sütun bazında yüklüyoruz.
            Rem Burada Say isimli sayaç aynı zamanda sütun olarak kullanılmıştır.
            Liste(1, Say) = Aranan
            Rem Sayısal değerler sonuç dizisine yükleniyor.
            Liste(2, Say) = Veri(X, 2)
            Liste(3, Say) = Veri(X, 3)
        Else
            Rem Anahtar verimiz döngü sırasında tekrar ediyorsa yani bu durumda mükerrer oluyor, makromuz bu bölüme geçecektir.
            Rem Anahtar verimiz döngü sırasında tekrar ediyorsa yani bu durumda mükerrer oluyor, makromuz bu bölüme geçecektir.
            Rem Örneklersek; sayfadaki 2. ve 3. satırların A-D sütunları aynı anahtarı içeriyor. Else satırından önce excelin 2. satırı benzersiz olduğu için diziye ekleniyor.
            Rem Else satırından sonra ise excelin 3. satırı işleme alınıyor. Çünkü 3. satır 2. satırın anahtar bakımından tekrarıdır.
            Rem Else satırından önce sonuç dizisine alınan sayısal değerlerin üzerine 3. satırdaki değerleri ekleyerek toplama işlemi yapıyoruz.
            Rem Buradaki ince nokta ise anahtar verimizi Dictionary kütüphanesine yüklerken kullandığımız sayaç değeridir.
            Rem Bu değeri kullanarak sonuç dizisindeki yerini tespit  ediyoruz ve doğru eşleşmeyi sağlıyoruz.
            Liste(2, Dizi.Item(Aranan)) = Liste(2, Dizi.Item(Aranan)) + Veri(X, 2)
            Liste(3, Dizi.Item(Aranan)) = Liste(3, Dizi.Item(Aranan)) + Veri(X, 3)
        End If
    Next
    Rem Döngü sonu...
 
    Rem Eğer sayacımı sıfırdan büyükse bir sonuç dizisi oluşmuştur. Bu oluşan sonuç listesini excelde bir alana yazdıracağız.
    If Say > 0 Then
        Rem Sonuç listemizi G1 hücresinden itibaren sayfamıza yazdırıyoruz. Sonuç listemiz 3 satırlı ve Say değişkenindeki kadar sütunlu olacaktır.
        S1.Range("G1").Resize(3, Say) = Liste
        Rem G1 ve sağındaki listelenen sütunları kalınlaştırıyoruz.
        S1.Range("G1").Resize(1, Say).Font.Bold = True
        Rem G1 ve sağındaki listelenen sütunları ortalıyoruz.
        S1.Range("G1").Resize(1, Say).HorizontalAlignment = xlCenter
        Rem F2-F3 hücrelerine başlıkları yazdırıyoruz.
        S1.Range("F2:F3").Value = Application.Transpose(Array("TOPLAM SATIŞ", "ŞUBE SAYISI"))
        Rem F2-F3 hücrelerini kalınlaştırıyoruz.
        S1.Range("F2:F3").Font.Bold = True
        Rem Sayfadaki tüm sütunların genişliklerini ayarlıyoruz.
        S1.Columns.AutoFit
        Rem Sayfadaki tüm satırların yüksekliklerini ayarlıyoruz.
        S1.Rows.AutoFit
    End If

    Rem makronun tamamlandığına dair kullanıcıya bilgilendirme mesajı veriyoruz.
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Genişletmek için tıkla ...
Çok teşekkür ederim Korhan Bey. Basit düzeyde de olsa temel bilgilere sahibim bilgilendirme mesajı, değişken tanımlama vb. gibi. Ancak sorularımı sorarken aynı zamanda da anlamak istediğim için küçük notlarınız benim için önemli. Elinize,emeğinize,zihninize sağlık.
 
H

HamzaFurkan

Katılım
19 Ocak 2022
Mesajlar
2
Excel Vers. ve Dili
2016 türkçe
Ömer' Alıntı:
Merhaba,

A sütunundaki verileri B2 den itibaren benzersiz olarak satıra yazar.
Kod: 
Sub Ozet_Cevir()

    Dim d As Object, i As Long, deg

    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i
 
    Range(Cells(2, "B"), Cells(2, Columns.Count)).ClearContents
    Range("B2").Resize(1, d.Count) = d.keys

End Sub
Genişletmek için tıkla ...
Ömer hocam saygılar. Hocam ben bu koddaki komutların bazılarını anlamadım genel olarak kısa bir şekilde ne işe yaradıklarını anlatabilir misiniz? teşekkürler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst