zetkatamet
Altın Üye
- Katılım
- 13 Mart 2008
- Mesajlar
- 1,408
- Excel Vers. ve Dili
- Office 365 Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub test()
a = Range("B3:B" & Cells(Rows.Count, 2).End(3).Row).Value
Set dc = CreateObject("scripting.dictionary")
For i = 1 To UBound(a)
If Not IsEmpty(a(i, 1)) Then
w = Split(a(i, 1), " ")
For j = 0 To UBound(w)
krt = w(j)
dc(krt) = dc(krt) + 1
Next j
End If
Next i
Range("D3:E" & Rows.Count).ClearContents
Range("D3:E" & Rows.Count).ClearFormats
[D3].Resize(dc.Count, 2) = Application.Transpose(Array(dc.keys, dc.items))
[D3].Resize(dc.Count, 2).Borders.Color = rgbSilver
MsgBox "İşlem tamam...", vbInformation
End Sub