Bir sütundaki veriyi yan yana satırlara getirme

SKBR · 24 Nisan 2020

Arkadaşlar merhaba, elimde bir rapor var ve ben bu raporda belli bir sütunu yan yana gelecek şekilde satıra çevirmek istiyorum. Bahsettiğim sütun 50 60 satırdan oluşuyor.
Yalnız çevrim yaparken şu konu önemli ilgili sütundaki veriler birbirini tekrarlayabilir. Yani "A" sayısından 4 tane olabilir. Bu durumda A sayısını bir kere almalı. Bu işlemi VBA ile yapmak istiyorum. Konu ile ilgili yardımcı olabilir misiniz?

Ömer · 24 Nisan 2020

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

SKBR · 24 Nisan 2020

Ömer' Alıntı:
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

Çok teşekkür ederim.

Korhan Ayhan · 24 Nisan 2020

Böyle de olabilir;

Benzersiz veriler D2 hücresinden itibaren listelenir.

C++:

Option Explicit

Sub Benzersiz_Liste()
    Dim Veri As Variant, X As Long, Son As Long, Zaman As Double
   
    Zaman = Timer
   
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value
   
    Range("B:Z").Clear
   
    With CreateObject("Scripting.Dictionary")
        For X = LBound(Veri) To UBound(Veri)
            .Item(Veri(X, 1)) = 1
        Next
        Range("D2").Resize(1, .Count) = .Keys
    End With

    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

SKBR · 27 Nisan 2020

Korhan Ayhan' Alıntı:

Böyle de olabilir;

Benzersiz veriler D2 hücresinden itibaren listelenir.

C++:

Option Explicit

Sub Benzersiz_Liste()
    Dim Veri As Variant, X As Long, Son As Long, Zaman As Double
  
    Zaman = Timer
  
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value
  
    Range("B:Z").Clear
  
    With CreateObject("Scripting.Dictionary")
        For X = LBound(Veri) To UBound(Veri)
            .Item(Veri(X, 1)) = 1
        Next
        Range("D2").Resize(1, .Count) = .Keys
    End With

    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

Çok teşekkür ederim Korhan Bey.

SKBR · 27 Nisan 2020

Korhan Bey, Ömer Bey eğer izniniz olursa bu konu ile ilgili birkaç sorum olacak sizlere. Benim elimde kalabalık satır ve sütunlardan oluşan bir rapor var. Bu raporda yukarıda belirttiğiniz şekilde bir sütundaki verileri yan yana yazdırıp, raporun içeriğinde bulunan birkaç sütununda ismini alt alta yazdırarak ilgili verilere ulaşmak istiyorum.
Örnek vermem gerekirse yan yana yazdırmak istediğim veriler ürün isimleri, alt alta yazdırmak istediğim başlıklar şube sayısı,satış miktarı vs.. Bu başlıklar geldikten sonra ilgili ürüne ait olan satış miktarının toplamı rapordan çekilerek ilgili hücreye yazılarak kullanıcının karşısında olmalı.
Ben toplam kısmını aşağıdaki şekilde oluşturdum ancak bu pek pratik bir oluşum olmadı sanırım.

Kod:

Sayfa3.Cells(2, 2) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!b1) * (sayfa1!o2:o65536))")
Sayfa3.Cells(3, 2) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!b1) * (sayfa1!q2:q65536))")
Sayfa3.Cells(4, 2) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!b1) * (sayfa1!s2:s65536))")
Sayfa3.Cells(5, 2) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!b1) * (sayfa1!u2:u65536))")
Sayfa3.Cells(6, 2) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!b1) * (sayfa1!v2:v65536))")
Sayfa3.Cells(7, 2) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!b1) * (sayfa1!w2:w65536))")
Sayfa3.Cells(8, 2) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!b1) * (sayfa1!x2:x65536))")
Sayfa3.Cells(9, 2) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!b1) * (sayfa1!y2:y65536))")

Sayfa3.Cells(2, 3) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!c1) * (sayfa1!o2:o65536))")
Sayfa3.Cells(3, 3) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!c1) * (sayfa1!q2:q65536))")
Sayfa3.Cells(4, 3) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!c1) * (sayfa1!s2:s65536))")
Sayfa3.Cells(5, 3) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!c1) * (sayfa1!u2:u65536))")
Sayfa3.Cells(6, 3) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!c1) * (sayfa1!v2:v65536))")
Sayfa3.Cells(7, 3) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!c1) * (sayfa1!w2:w65536))")
Sayfa3.Cells(8, 3) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!c1) * (sayfa1!x2:x65536))")
Sayfa3.Cells(9, 3) = Evaluate("=SumProduct((sayfa1!j2:j65536 = sayfa3!c1) * (sayfa1!y2:y65536))")

Bu şekilde devam ediyor, ama söylediğim gibi pek pratik olmadı. Bahsettiğim çalışma için bana yardımcı olabilmeniz mümkün müdür?
Çok teşekkürler şimdiden.

Korhan Ayhan · 27 Nisan 2020

Örnek dosyanızı paylaşırsanız daha sağıklı yardımcı olabiliriz.

SKBR · 27 Nisan 2020

Korhan Ayhan' Alıntı:
Örnek dosyanızı paylaşırsanız daha sağıklı yardımcı olabiliriz.

SKBR · 27 Nisan 2020

Korhan Ayhan' Alıntı:
Örnek dosyanızı paylaşırsanız daha sağıklı yardımcı olabiliriz.

https://we.tl/t-sknnkxRVtK

İStediğim formata uygun bir ekran görüntüsü ekledim. Çok teşekkür ederim şimdiden.

Korhan Ayhan · 27 Nisan 2020

Bu da alışkanlık haline geldi. Örnek dosya istiyoruz ekran görüntüsü paylaşılıyor.

SKBR · 27 Nisan 2020

Korhan Ayhan' Alıntı:
Bu da alışkanlık haline geldi. Örnek dosya istiyoruz ekran görüntüsü paylaşılıyor.

SKBR · 27 Nisan 2020

Korhan Ayhan' Alıntı:
Bu da alışkanlık haline geldi. Örnek dosya istiyoruz ekran görüntüsü paylaşılıyor.

Kusura bakmayın. Dosyayı ekledim. Tekrar teşekkür ederim.
https://we.tl/t-no7PeXGKEJ

Korhan Ayhan · 27 Nisan 2020

Deneyiniz.

C++:

Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Veri As Variant
    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
    
    Set S2 = Sheets.Add(, Sheets(Sheets.Count))
    
    S2.Name = "Analiz-" & Sheets.Count - 1
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    Veri = S1.Range("B2:D" & Son).Value
    
    ReDim Liste(1 To 3, 1 To S1.Columns.Count)
    
    For X = LBound(Veri) To UBound(Veri)
        If Not Dizi.Exists(Veri(X, 1)) Then
            Say = Say + 1
            Dizi.Add Veri(X, 1), Say
            Liste(1, Say) = Veri(X, 1)
            Liste(2, Say) = Veri(X, 2)
            Liste(3, Say) = Veri(X, 3)
        Else
            Liste(2, Dizi.Item(Veri(X, 1))) = Liste(2, Dizi.Item(Veri(X, 1))) + Veri(X, 2)
            Liste(3, Dizi.Item(Veri(X, 1))) = Liste(3, Dizi.Item(Veri(X, 1))) + Veri(X, 3)
        End If
    Next
    
    If Say > 0 Then
        With S2
            .Range("B1").Resize(3, Say) = Liste
            .Range("B1").Resize(1, Say).Font.Bold = True
            .Range("B1").Resize(1, Say).HorizontalAlignment = xlCenter
            .Range("A2:A3").Value = Application.Transpose(Array("TOPLAM SATIŞ", "ŞUBE SAYISI"))
            .Range("A2:A3").Font.Bold = True
            .Range("A1").CurrentRegion.Borders.LineStyle = 1
            .Columns.AutoFit
            .Select
        End With
    End If

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

SKBR · 27 Nisan 2020

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Veri As Variant
    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
   
    Set S2 = Sheets.Add(, Sheets(Sheets.Count))
   
    S2.Name = "Analiz-" & Sheets.Count - 1
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    Veri = S1.Range("B2:D" & Son).Value
   
    ReDim Liste(1 To 3, 1 To S1.Columns.Count)
   
    For X = LBound(Veri) To UBound(Veri)
        If Not Dizi.Exists(Veri(X, 1)) Then
            Say = Say + 1
            Dizi.Add Veri(X, 1), Say
            Liste(1, Say) = Veri(X, 1)
            Liste(2, Say) = Veri(X, 2)
            Liste(3, Say) = Veri(X, 3)
        Else
            Liste(2, Dizi.Item(Veri(X, 1))) = Liste(2, Dizi.Item(Veri(X, 1))) + Veri(X, 2)
            Liste(3, Dizi.Item(Veri(X, 1))) = Liste(3, Dizi.Item(Veri(X, 1))) + Veri(X, 3)
        End If
    Next
   
    If Say > 0 Then
        With S2
            .Range("B1").Resize(3, Say) = Liste
            .Range("B1").Resize(1, Say).Font.Bold = True
            .Range("B1").Resize(1, Say).HorizontalAlignment = xlCenter
            .Range("A2:A3").Value = Application.Transpose(Array("TOPLAM SATIŞ", "ŞUBE SAYISI"))
            .Range("A2:A3").Font.Bold = True
            .Range("A1").CurrentRegion.Borders.LineStyle = 1
            .Columns.AutoFit
            .Select
        End With
    End If

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

Teşekkür ederim, istediğim şekilde olmuş. Asıl dosyaya uyarlamam için bir öneriniz var mıdır peki?

Korhan Ayhan · 27 Nisan 2020

Nasıl bir öneri istiyorsunuz?

SKBR · 27 Nisan 2020

Korhan Ayhan' Alıntı:
Nasıl bir öneri istiyorsunuz?

Şöyleki asıl dosyada örnek göndermiş olduğum dosyada iki veriye göre analiz ediliyordu. Asıl dosyada 2'den fazla veriye göre sonuca ulaşmam gerekiyor. Bir de sanırım şuradaki kod kısmında Veri = S1.Range("B2

" & Son).Value B2 ile eşleşen D'ye kadar olan sütunlardaki değerler ile alakalı bir veri geliyor. Peki sütunlarım sıralı gitmez ise nasıl bir kod yazmam gerekir? Yani D sütunu var diyelim, sonra F sütunundaki veri gelecek. O aradaki "E" sütunundakinin gelmesini istemiyorum gibi bir durum olduğunda ne yapmalıyım?

Korhan Ayhan · 27 Nisan 2020

Veri(X,1) seçtiğiniz alanın ilk sütununu ifade eder. 1 değeri ile oynayarak istediğiniz sütunları kontrol edip listeye dahil ya da hariç bırakabilirsiniz.

SKBR · 27 Nisan 2020

Korhan Ayhan' Alıntı:
Veri(X,1) seçtiğiniz alanın ilk sütununu ifade eder. 1 değeri ile oynayarak istediğiniz sütunları kontrol edip listeye dahil ya da hariç bırakabilirsiniz.

Çok teşekkür ederim yardımlarınız için.

SKBR · 12 Mayıs 2020

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Veri As Variant
    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
   
    Set S2 = Sheets.Add(, Sheets(Sheets.Count))
   
    S2.Name = "Analiz-" & Sheets.Count - 1
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    Veri = S1.Range("B2:D" & Son).Value
   
    ReDim Liste(1 To 3, 1 To S1.Columns.Count)
   
    For X = LBound(Veri) To UBound(Veri)
        If Not Dizi.Exists(Veri(X, 1)) Then
            Say = Say + 1
            Dizi.Add Veri(X, 1), Say
            Liste(1, Say) = Veri(X, 1)
            Liste(2, Say) = Veri(X, 2)
            Liste(3, Say) = Veri(X, 3)
        Else
            Liste(2, Dizi.Item(Veri(X, 1))) = Liste(2, Dizi.Item(Veri(X, 1))) + Veri(X, 2)
            Liste(3, Dizi.Item(Veri(X, 1))) = Liste(3, Dizi.Item(Veri(X, 1))) + Veri(X, 3)
        End If
    Next
   
    If Say > 0 Then
        With S2
            .Range("B1").Resize(3, Say) = Liste
            .Range("B1").Resize(1, Say).Font.Bold = True
            .Range("B1").Resize(1, Say).HorizontalAlignment = xlCenter
            .Range("A2:A3").Value = Application.Transpose(Array("TOPLAM SATIŞ", "ŞUBE SAYISI"))
            .Range("A2:A3").Font.Bold = True
            .Range("A1").CurrentRegion.Borders.LineStyle = 1
            .Columns.AutoFit
            .Select
        End With
    End If

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

Korhan Bey merhaba,

Bir konuda daha sizden yardım rica ediyorum. Daha önce yardım etmiş olduğunuz şekilde kodlarımı oluşturdum. Ancak şöyle bir şey eklemek istiyorum çalışmaya. yukarıdaki kodlarla yanyana getirmiş olduğumuz verilerin bulunduğu hücrelere farklı bir sütunda bulunan verileri de yazdırmak istiyorum.
Mesela A sütununda 1-2-3 yazıyor diyelim.
B sütununda da a-b-c yazıyor.
Bizim yukarıdaki çalışmamızda a sütunundaki "1-2-3" değerleri yan yana geliyor. "A1=1", "B1=2", "C1=3" gibi.
Benim şu an istediğim şey şu "A1= 1 - a" , "B1= 2 - b" yazsın. Bunun için nasıl bir yol izleyebilirim?

Korhan Ayhan · 12 Mayıs 2020

Örnek ekleyerek açıklarsanız daha faydalı olacaktır.

Bir sütundaki veriyi yan yana satırlara getirme

SKBR

Ömer

Moderatör

SKBR

Korhan Ayhan

Administrator

SKBR

SKBR

Korhan Ayhan

Administrator

SKBR

SKBR

Korhan Ayhan

Administrator

SKBR

SKBR

Korhan Ayhan

Administrator

SKBR

Korhan Ayhan

Administrator

SKBR

Korhan Ayhan

Administrator

SKBR

SKBR

Korhan Ayhan

Administrator