Macro ile tek hücrede yazılı adları yan hücrelere sıralama

Katılım
17 Ocak 2019
Mesajlar
31
Excel Vers. ve Dili
Office 2013
Yeni dosyanız içinde aşağıdaki kodu deneyiniz.

C++:
Option Explicit

Sub Sembol_Say()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object
    Dim Veri As Variant, Son As Long, X As Long, Y As Integer
    Dim Metin As Variant, Say As Long, Zaman As Double
   
    Zaman = Timer
   
    Set S1 = Sheets("İLK HALİ")
    Set S2 = Sheets("OLMASINI İSTEDİĞİM")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    S2.Range("A2:B" & S2.Rows.Count).Clear
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son <= 2 Then Son = 3
   
    Veri = S1.Range("C2:C" & Son).Value
   
    ReDim Liste(1 To Son, 1 To 2)
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Metin = Split(Veri(X, 1), "," & Chr$(160))
        For Y = LBound(Metin) To UBound(Metin)
            If Not Dizi.Exists(Metin(Y)) Then
                Say = Say + 1
                Dizi.Add Metin(Y), Say
                Liste(Say, 1) = Metin(Y)
                Liste(Say, 2) = 1
            Else
                Liste(Dizi.Item(Metin(Y)), 2) = Liste(Dizi.Item(Metin(Y)), 2) + 1
            End If
        Next
    Next
   
    S2.Range("A2").Resize(Say, 2) = Liste
    S2.Range("A2").Resize(Say, 2).Borders.LineStyle = 1
    S2.Range("A2:B" & S2.Rows.Count).Sort S2.Range("B2"), xlDescending, , , , , , xlNo
    S2.Columns.AutoFit
    S2.Select
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
Korhan Bey, Tam istediğim gibi olmuş ellerinize sağlık...
 
Katılım
17 Ocak 2019
Mesajlar
31
Excel Vers. ve Dili
Office 2013
Yeni dosyanız içinde aşağıdaki kodu deneyiniz.

C++:
Option Explicit

Sub Sembol_Say()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object
    Dim Veri As Variant, Son As Long, X As Long, Y As Integer
    Dim Metin As Variant, Say As Long, Zaman As Double
  
    Zaman = Timer
  
    Set S1 = Sheets("İLK HALİ")
    Set S2 = Sheets("OLMASINI İSTEDİĞİM")
    Set Dizi = CreateObject("Scripting.Dictionary")
  
    S2.Range("A2:B" & S2.Rows.Count).Clear
  
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son <= 2 Then Son = 3
  
    Veri = S1.Range("C2:C" & Son).Value
  
    ReDim Liste(1 To Son, 1 To 2)
  
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Metin = Split(Veri(X, 1), "," & Chr$(160))
        For Y = LBound(Metin) To UBound(Metin)
            If Not Dizi.Exists(Metin(Y)) Then
                Say = Say + 1
                Dizi.Add Metin(Y), Say
                Liste(Say, 1) = Metin(Y)
                Liste(Say, 2) = 1
            Else
                Liste(Dizi.Item(Metin(Y)), 2) = Liste(Dizi.Item(Metin(Y)), 2) + 1
            End If
        Next
    Next
  
    S2.Range("A2").Resize(Say, 2) = Liste
    S2.Range("A2").Resize(Say, 2).Borders.LineStyle = 1
    S2.Range("A2:B" & S2.Rows.Count).Sort S2.Range("B2"), xlDescending, , , , , , xlNo
    S2.Columns.AutoFit
    S2.Select
  
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
  
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
Korhan Bey, Son gönderdiğiniz macro harika çok teşekkür ederim. Yukarıdaki Excel e "İSTATİSTİK" adlı bir sayfa daha açsam orayada aşağıdaki linkte belirttiğim gibi bir düzzenleme yapılabilir mi? (Üstteki ve Soldaki adlar sürekli değişiklik göstermektedir)
 

Korhan Ayhan

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

Üstteki ve soldaki adlar bölümünü siz mi dolduracaksınız? Yoksa makro otomatik listede ne varsa listeleyecek mi?
 
Katılım
17 Ocak 2019
Mesajlar
31
Excel Vers. ve Dili
Office 2013
Merhaba Korhan Bey, Önceki yaptığınız macroları sorunsuz kullanıyorum. Mümkün ise bir isteğim daha olacak. Birde ayrı bir sayfada saate göre kaç kez geldiğini pivotlama şansımız olabilirmi?
Ben sayfayı açtım şablonu hazırladım. Şimdiden teşekkürler...

 
Katılım
17 Ocak 2019
Mesajlar
31
Excel Vers. ve Dili
Office 2013
Merhabalar, Dosyanın son işlemlerini Korhan Bey, yaptığı için mesajımı Korhan Bey olarak atmıştım. Bilgisi olan diğer Yönetici arkadaşlarda bakabilir ise çok sevinirim...
 
Üst