返回列表 上一主題 發帖

求解:多重對比合并資料

求解:多重對比合并資料

本帖最後由 198188 於 2024-5-27 14:14 編輯

未命名.jpg
2024-5-27 14:02


Data 表内 做資料分析,移除重複項 (欄B, D, E 三個都一致),但是需要加總欄F & 欄 H
舉例:
下面的數據資料:
   欄 B        欄 C        欄 D         欄 E              欄 F        欄 G        欄 H
FC120                     912.5         2425.6                 1        2.213         2.213
FC120                     912.5         2425.6                 2        2.213         4.426
FC120                     912.5         2425.6                 1        2.213         2.213
FC149                    1204.0         2425.6                 2        2.920         5.840
FC120                    1197.0         2425.6                 1        2.903         2.903

結果:
欄 B              欄 C            欄 D                欄 E                 欄 F          欄 G               欄 H
FC120                          912.5             2425.6                4                 2.213              8.852
FC149                        1204.0             2425.6                2                 2.920             5.840
FC120                        1197.0             2425.6                1                 2.903             2.903

sample.rar (19.22 KB)

本帖最後由 hugh0620 於 2024-5-30 10:06 編輯

回復 1# 198188

有比對你檔案中的 Data 跟 Result 的資料。
如果僅是一次性的資料,可以做以下處理。
圖號:用excel視窗上"資料"、"移除重複",可以得到每筆圖號得唯一。
長、寬/米重、面積/重量 (M² / kg)的單計、,Data跟 Result 是一樣的,所以,可以用Vlookup就可以得到。
ex、長 D10  =VLOOKUP(B10,Data!$B$12:$G$1000,3,FALSE)

F欄位"數量"、H欄位"小計資料",可以用Sumif進行統計。
EX、 數量 F10  =SUMIF(Data!$B$12:$B$1000,Result!B10,Data!$F$12:$F$1000)

如果你要VBA處理,可以錄一段"圖號""移除重複"的程式碼,以下是用ChatGPT跑出來的程式碼
  1. Sub CopyUniqueValues()
  2.     Dim ws1 As Worksheet
  3.     Dim ws2 As Worksheet
  4.     Dim rng As Range
  5.     Dim cell As Range
  6.     Dim dict As Object
  7.     Dim i As Long
  8.    
  9.     ' 設定工作表
  10.     Set ws1 = ThisWorkbook.Sheets("Data")
  11.     Set ws2 = ThisWorkbook.Sheets("Result")
  12.    
  13.     ' 設定範圍
  14.     Set rng = ws1.Range("B12:B10000")
  15.    
  16.     ' 使用字典來儲存唯一值
  17.     Set dict = CreateObject("Scripting.Dictionary")
  18.    
  19.     ' 清空Result的B欄位
  20.     ws2.Range("B10:B10000").ClearContents
  21.    
  22.     ' 遍歷範圍中的每個儲存格,並將唯一值添加到字典中
  23.     For Each cell In rng
  24.         If Not dict.exists(cell.Value) And cell.Value <> "" Then
  25.             dict.Add cell.Value, Nothing
  26.         End If
  27.     Next cell
  28.    
  29.     ' 將唯一值寫入工作表2的A欄位
  30.     i = 10
  31.     For Each key In dict.keys
  32.         ws2.Cells(i, 2).Value = key
  33.         i = i + 1
  34.     Next key
  35. ' 对工作表2的B列进行排序
  36. ws2.Range("B10:B" & i - 1).Sort Key1:=ws2.Range("B9"), Order1:=xlAscending, Header:=xlNo
  37. End Sub
複製代碼
學習才能提升自己

TOP

本帖最後由 198188 於 2024-5-30 10:55 編輯
回復  198188

有比對你檔案中的 Data 跟 Result 的資料。
如果僅是一次性的資料,可以做以下處理。
圖 ...
hugh0620 發表於 2024-5-30 09:43


謝謝前輩指導。
但是這個不是單一重複移除,是三個條件重複移除。 (圖號,長,寬)這三個資料都相同的才重複移除。
我就用了比較繁複的步驟:
1 將Data 數據 根據 (圖號,長,寬)來排序
2 再逐行跟前一行對比是否相同
3 相同就加總數量及小計
4 再複製到Result
這個運行的時間上就比較長。

TOP

基本字典應用..之前很多問帖都有用過, 可見還是沒有用心去理解//
有些問題還是可以自行去解決的///
Sub Test_a1()
Dim Arr, xD, T$, i&, j&, N&
Sheets("Result").UsedRange.Offset(10).EntireRow.Delete
[Result!a10:i10] = ""
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Data!i1], [data!a65536].End(3))
For i = 10 To UBound(Arr)
    If Not IsNumeric(Arr(i, 1) & "") Then GoTo i01
    T = Arr(i, 2) & "\" & Arr(i, 4) & "\" & Arr(i, 5)
    If xD(T) = 0 Then
       N = N + 1: xD(T) = N: Arr(N, 1) = N
       For j = 2 To UBound(Arr, 2): Arr(N, j) = Arr(i, j): Next
    Else
       j = xD(T)
       Arr(j, 6) = Arr(j, 6) + Arr(i, 6)
       Arr(j, 8) = Arr(j, 8) + Arr(i, 8)
    End If
i01: Next i
If N = 0 Then Exit Sub
With [Result!a10:i10].Resize(N)
     .Rows(1).Copy .Cells
     .Value = Arr
     .Columns(2).Resize(, 8).Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlNo
End With
End Sub

TOP

基本字典應用..之前很多問帖都有用過, 可見還是沒有用心去理解//
有些問題還是可以自行去解決的///
Sub T ...
准提部林 發表於 2024-5-30 15:32


謝謝准大指點!
這個問題我已經用比較笨拙的程式解決。
由於字典應用知識比較缺乏,未能靈活使用。
所以發問貼,希望可以透過各位前輩的指點,從中學習字典使用技巧。

TOP

        靜思自在 : 不怕事多,只怕多事。
返回列表 上一主題