Tek Sütundaki Verileri 2 Sütuna Böl

[baydeniro]

Merhaba arkadaşlar,
1 sütundaki bulunan sayısal verileri 2 sütuna ayırmak mümkün müdür ! Resimde bir örneği bulunuyor.

**1 mağaza için aynı üründen daima 2 veri yazılı oluyor (veya boş oluyor)
** rakamlar daima birbirinden farklı oluyor

 

[Ziynettin]

Ekli dosyanız.

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Say As Long, Fiyat As Double
    Dim Magaza As String, Son As Long, Veri As Variant, X As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("MAGAZA")
    Set S2 = Sheets("LISTE")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    S2.Range("A4:C" & S2.Rows.Count).Clear
    
    Magaza = S2.Range("B1").Value
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:C" & Son).Value2
    
    ReDim Liste(1 To UBound(Veri), 1 To 3)
    
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) = Magaza Then
            If Not Dizi.Exists(Veri(X, 2)) Then
                Say = Say + 1
                Dizi.Add Veri(X, 2), Say
                Liste(Say, 1) = Veri(X, 2)
                Liste(Say, 2) = Veri(X, 3)
            Else
                If Liste(Dizi.Item(Veri(X, 2)), 2) > Veri(X, 3) Then
                    Fiyat = Liste(Dizi.Item(Veri(X, 2)), 2)
                    Liste(Dizi.Item(Veri(X, 2)), 2) = Veri(X, 3)
                    Liste(Dizi.Item(Veri(X, 2)), 3) = Fiyat
                Else
                    Liste(Dizi.Item(Veri(X, 2)), 3) = Veri(X, 3)
                End If
            End If
        End If
    Next

    If Say > 0 Then S2.Range("A4").Resize(Say, 3) = Liste
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[Ziynettin]

Korhan Bey,
Elinize sağlık. Güzel bir çalışma olmuş.

 

[Korhan Ayhan]

@Ziynettin Bey,

Sizinde elinize sağlık..

 

[baydeniro]

Ekli dosyanız.

Üstad çok teşekkür ediyorum. emeğinize sağlık, sağlıcakla kalın

 

[baydeniro]

Alternatif;

Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Say As Long, Fiyat As Double
    Dim Magaza As String, Son As Long, Veri As Variant, X As Long, Zaman As Double
   
    Zaman = Timer
   
    Set S1 = Sheets("MAGAZA")
    Set S2 = Sheets("LISTE")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    S2.Range("A4:C" & S2.Rows.Count).Clear
   
    Magaza = S2.Range("B1").Value
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:C" & Son).Value2
   
    ReDim Liste(1 To UBound(Veri), 1 To 3)
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) = Magaza Then
            If Not Dizi.Exists(Veri(X, 2)) Then
                Say = Say + 1
                Dizi.Add Veri(X, 2), Say
                Liste(Say, 1) = Veri(X, 2)
                Liste(Say, 2) = Veri(X, 3)
            Else
                If Liste(Dizi.Item(Veri(X, 2)), 2) > Veri(X, 3) Then
                    Fiyat = Liste(Dizi.Item(Veri(X, 2)), 2)
                    Liste(Dizi.Item(Veri(X, 2)), 2) = Veri(X, 3)
                    Liste(Dizi.Item(Veri(X, 2)), 3) = Fiyat
                Else
                    Liste(Dizi.Item(Veri(X, 2)), 3) = Veri(X, 3)
                End If
            End If
        End If
    Next

    If Say > 0 Then S2.Range("A4").Resize(Say, 3) = Liste
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Üstad çok teşekkür ediyorum. emeğinize sağlık, sağlıcakla kalın