snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Dim d As Object, a(999, 2) As Variant, i As Integer
Dim rall As Range, r1 As Range, r2 As Range, j As Integer
Set d = CreateObject("Scripting.Dictionary")
With Sheets("ฐานข้อมูล")
Set rall = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
For Each r In rall
If Not d.exists(r.Value) Then
d.Add Key:=r.Value, Item:=r.Value
a(i, 0) = r.Value
j = 1
For Each r1 In rall
If r1.Value = a(i, 0) Then
a(i, 1) = j
a(i, 2) = a(i, 2) + r1.Offset(0, 1).Value
j = j + 1
End If
Next r1
i = i + 1
End If
Next r
End With
With Sheets("ทดสอบ")
.Range("a5").Resize(.UsedRange.Rows.Count, 3).ClearContents
.Range("a5").Resize(i + 1, 3).Value = a
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("a5").Resize(i), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("a5").Resize(i, 3)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
