12
返回列表 上一主題 發帖

[發問] 重複內容時間加總並刪除重複保留唯一值

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
4# 跳轉到 »
發表於 2020-12-14 13:32 | 只看該作者
回復 2# samwang


你忘記累加頭一列了喔~

    If xD.Exists(T & "") Then
        NR = xD(T & "")
        Arr(NR, 13) = Arr(NR, 13) + Arr(i, 12)
    Else
        N = N + 1
        xD(T & "") = N
        For j = 1 To 12: Arr(N, j) = Arr(i, j): Next
        Arr(N, 13) = Arr(N, 12)
   End If
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

hcm19522

帖子
1387 
主題
4 
精華
0 
積分
1397 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2015-9-11 
最後登錄
2024-11-25 

熱烈參與勳章
3#
發表於 2020-12-14 13:06 | 只看該作者
https://blog.xuite.net/hcm19522/twblog/589509290
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2024-10-30 
2#
發表於 2020-12-14 08:48 | 只看該作者
回復 1# v03586

請測試看看，感謝。

Sub TEST()
Dim Arr, xD, T, N&, j%, NR&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([M1], [A65536].End(3))
For i = 1 To UBound(Arr)
    T = Arr(i, 9) & Arr(i, 10)
    If xD.Exists(T & "") Then
        NR = xD(T & "")
        Arr(NR, 13) = Arr(NR, 13) + Arr(i, 12)
    Else
        N = N + 1
        xD(T & "") = N
        For j = 1 To 12: Arr(N, j) = Arr(i, j): Next
  End If
Next
Range("A1:M" & [A65536].End(3).Row) = ""
Arr(1, 13) = "TIME"
[A1].Resize(N, 13) = Arr
End Sub

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
12
返回列表 上一主題