返回列表 上一主題 發帖

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
1# 跳轉到 »
發表於 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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
2#
發表於 2020-12-14 14:24 | 顯示全部帖子
回復 4# n7822123


你忘記累加頭一列了喔~

    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


請問n7822123 您提問題  忘記累加頭一列了喔~  ，是原本我回覆的那一列嗎?
感謝指教。

Range("A1:M" & [A65536].End(3).Row) = ""
Arr(1, 13) = "TIME"
[A1].Resize(N, 13) = Arr
End Sub

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
3#
發表於 2020-12-14 15:51 | 顯示全部帖子
回復 7# n7822123


感謝指導，真的很粗心大意，感恩。

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
4#
發表於 2020-12-14 16:17 | 顯示全部帖子
回復 1# v03586

更新程式碼如下，謝謝

Sub TEST_2()
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
        Arr(N, 13) = Arr(N, 12)
  End If
Next
Range("A1:M" & [A65536].End(3).Row) = ""
Arr(1, 13) = "TIME"
[A1].Resize(N, 13) = Arr
End Sub

TOP

        靜思自在 : 做該做的事是智慧，做不該做的事是愚癡。
返回列表 上一主題