- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2026-5-26
|
回復 samwang
Dear samwang,
午安!感謝您的回覆。
抱歉問題、檔案未提供說明清楚。我的結果畫面如下圖 ...
jsc0518 發表於 2021-11-22 14:57 
請測試看看,謝謝
Sub test()
Dim Arr, Brr, xD, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([繳庫量!g2], [繳庫量!g65536].End(3))
For i = 1 To UBound(Arr): xD(Arr(i, 1) & "") = xD(Arr(i, 1) & "") + 1: Next
With Sheets("Analysis")
Brr = .Range(.[a2], .[a65536].End(3))
For i = 1 To UBound(Brr):
If xD(Brr(i, 1) & "") > 0 Then
Brr(i, 1) = xD(Brr(i, 1) & "")
Else
Brr(i, 1) = 0
End If
Next
.Range("f2").Resize(UBound(Brr)) = Brr
End With
End Sub |
|