返回列表 上一主題 發帖

計算不重複資料出現次數 [已解決]

  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. For Each a In Range([A1], [A1].End(xlDown))
  4.   If IsEmpty(d(a.Value)) Then
  5.      d(a.Value) = a.Offset(, 1)
  6.   ElseIf IsError(Application.Match(a.Offset(, 1), Split(d(a.Value), ","), 0)) Then
  7.      d(a.Value) = d(a.Value) & "," & a.Offset(, 1)
  8.   End If
  9. Next
  10. For Each ky In d.keys
  11.   d(ky) = Array(ky, UBound(Split(d(ky), ",")) + 1)
  12. Next
  13. [C1].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
  14. End Sub
複製代碼
回復 3# loyyee
學海無涯_不恥下問

TOP

回復 5# loyyee
  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. For Each a In Range([A1], [A1].End(xlDown))
  4.   If IsEmpty(d(a.Value)) Then
  5.      d(a.Value) = a.Offset(, 1)
  6.   ElseIf IsError(Application.Match(a.Offset(, 1), Split(d(a.Value), ","), 0)) Then
  7.      d(a.Value) = d(a.Value) & "," & a.Offset(, 1)
  8.   End If
  9. Next
  10. For Each ky In d.keys
  11.   d(ky) = Array(ky, UBound(Split(d(ky), ",")) + 1)
  12. If mystr = "" Then
  13.   mystr = Join(d(ky), "次數=")
  14.   Else
  15.   mystr = mystr & Chr(10) & Join(d(ky), "次數=")
  16. End If
  17. Next
  18. mystr = mystr & Chr(10) & "筆數= " & d.Count & "(因出現 : " & Join(d.keys, "、") & Application.Text(d.Count, "[DBNum1]") & "筆資料)"
  19. [C:E] = ""
  20. [C1].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
  21. [C1].Offset(d.Count, 3) = mystr
  22. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 世上有兩件事不能等:一、孝順 二、行善。
返回列表 上一主題