合并行和總和值（ 洗掉合并的）

自 48 小時以來，我已經對此進行了查找和測驗，但找不到正確的解決方案（或正確調整現有解決方案）。

附件是我的 Excel 截圖。基本上，我想說（在函式或 VBA 腳本中）：當“ICCID”（B 列）相同時，通過連接“國家”（M 列）合并行并在 O、P 列和問：（當然洗掉合并的行）

有沒有人可以解決這個問題？非常感謝您提前

uj5u.com熱心網友回復：

請嘗試下一個代碼。它將 ICCIDs 作為（唯一）鍵放置在字典中，并在專案陣列中保存要更新的行、連接的國家名稱和累積的必要值。使用陣列和字典，一次洗掉重復的行，它應該足夠快：

Sub mergeICCID()
  Dim sh As Worksheet, lastR As Long, arr, arrInt, i As Long, j As Long, iRow As Long, rngDel As Range, dict As Object
  
  Set sh = ActiveSheet
  lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row in B:B
  
  arr = sh.Range("B2:Q" & lastR).Value2 'place the range in an array for faster iteration and processing
  Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
  
  'fill the dictionary:
  For i = 1 To UBound(arr)
        If Not dict.Exists(arr(i, 1)) Then
            dict.Add arr(i, 1), Array(i, arr(i, 12), arr(i, 14), arr(i, 15), arr(i, 16))
        Else
            arrInt = dict(arr(i, 1))   'extract the item array
            arrInt(1) = arrInt(1) & ", " & arr(i, 12): arrInt(2) = arrInt(2)   arr(i, 14) 'concatenate country names and cumullate Usage Days
            arrInt(3) = arrInt(3)   arr(i, 15):  arrInt(4) = arrInt(4)   arr(i, 16)       'cummulate Usage value and Usage in Gb value
            dict(arr(i, 1)) = arrInt  'put back the adapted item array
            addToRange rngDel, sh.Range("A" & i   1)  'set the UNION range keeping rows to be deleted (at once) at the end
        End If
  Next i
  
  'Change the cumulated/concatenated array elements:
  For i = 0 To dict.count - 1
        iRow = dict.Items()(i)(0)
        arr(iRow, 12) = dict.Items()(i)(1) 'concatenated country names
        arr(iRow, 14) = dict.Items()(i)(2) 'cumulated Usage Days value
        arr(iRow, 15) = dict.Items()(i)(3) 'cumulated Usage value
        arr(iRow, 16) = dict.Items()(i)(4) 'cumulated Usage in Gb value
  Next i
  
  'drop back the updated array content:
  sh.Range("B2").Resize(UBound(arr), UBound(arr, 2)).Value2 = arr

  'delete the duplicate rows, at once:
  If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
  
  MsgBox "Ready..."
End Sub

Private Sub addToRange(rngU As Range, rng As Range)
    If rngU Is Nothing Then
        Set rngU = rng
    Else
        Set rngU = Union(rngU, rng)
    End If
End Sub

請在測驗后發送一些反饋。

編輯：

請嘗試下一個版本，該版本不會更新從 A:A 到 L:L 的范圍，并且僅處理 N:N 列中具有“EU”的情況：

Sub mergeICCID2Arrays()
  Dim sh As Worksheet, lastR As Long, arrB, arr, arrInt, i As Long, j As Long, iRow As Long, rngDel As Range, dict As Object
  
  Set sh = ActiveSheet
  lastR = sh.Range("B" & sh.rows.count).End(xlUp).row 'last row in B:B
  
  arrB = sh.Range("B2:B" & lastR).Value   'place the B:B range in an array (to be used only for setting the dictionary keys)
  arr = sh.Range("M2:P" & lastR).Value2   'place the range in an array for faster iteration and processing
  Set dict = CreateObject("Scripting.Dictionary") 'set the dictionary
  
  'fill the dictionary:
  For i = 1 To UBound(arr)
        If arr(i, 2) = "EU" Then 'process only cases having "EU" in column N:N
            If Not dict.Exists(arrB(i, 1)) Then
                dict.Add arrB(i, 1), Array(i, arr(i, 1), arr(i, 3), arr(i, 4))
            Else
                arrInt = dict(arrB(i, 1))   'extract the item array
                arrInt(1) = arrInt(1) & ", " & arr(i, 1)                                           'concatenate country names
                arrInt(2) = arrInt(2)   arr(i, 3):  arrInt(3) = arrInt(3)   arr(i, 4)  'cummulate Usage Days and Usage values
                dict(arrB(i, 1)) = arrInt  'put back the adapted item aray
                addToRange rngDel, sh.Range("A" & i   1)  'set the range keeping rows to be deleted
            End If
        End If
  Next i
  
  'Change the cumulated/concatenated array elements:
  For i = 0 To dict.count - 1
        iRow = dict.Items()(i)(0)
        arr(iRow, 1) = dict.Items()(i)(1) 'concatenated country names
        arr(iRow, 3) = dict.Items()(i)(2) 'cummulated Usage Days value
        arr(iRow, 4) = dict.Items()(i)(3) 'cummulated Usage value
 Next i
 
  'drop the adapted array content, at once:
  sh.Range("M2").Resize(UBound(arr), UBound(arr, 2)).Value2 = arr
  
   'delete the duplicate rows, at once:
  If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End Sub

標籤：擅长 vba

上一篇：在單擊“下一步”時到達該作業表的最后一個單元格后，用于回圈通過作業表上的預填充單元格的UserForm代碼遇到錯誤

下一篇：Visio資料記錄集物件