麻辣家族討論版版 - Powered by Discuz! Board

標題: 求解：多重對比合并資料 [打印本頁]

作者: 198188 時間: 2024-5-27 14:10 標題: 求解：多重對比合并資料

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

[attach]37768[/attach]

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

作者: hugh0620 時間: 2024-5-30 09:43

本帖最後由 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跑出來的程式碼

Sub CopyUniqueValues()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim cell As Range
Dim dict As Object
Dim i As Long
' 設定工作表
Set ws1 = ThisWorkbook.Sheets("Data")
Set ws2 = ThisWorkbook.Sheets("Result")
' 設定範圍
Set rng = ws1.Range("B12:B10000")
' 使用字典來儲存唯一值
Set dict = CreateObject("Scripting.Dictionary")
' 清空Result的B欄位
ws2.Range("B10:B10000").ClearContents
' 遍歷範圍中的每個儲存格，並將唯一值添加到字典中
For Each cell In rng
If Not dict.exists(cell.Value) And cell.Value <> "" Then
dict.Add cell.Value, Nothing
End If
Next cell
' 將唯一值寫入工作表2的A欄位
i = 10
For Each key In dict.keys
ws2.Cells(i, 2).Value = key
i = i + 1
Next key
' 对工作表2的B列进行排序
ws2.Range("B10:B" & i - 1).Sort Key1:=ws2.Range("B9"), Order1:=xlAscending, Header:=xlNo
End Sub

複製代碼

作者: 198188 時間: 2024-5-30 10:44

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

回復 198188

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

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

作者: 准提部林 時間: 2024-5-30 15:32

基本字典應用..之前很多問帖都有用過, 可見還是沒有用心去理解//
有些問題還是可以自行去解決的///
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

作者: 198188 時間: 2024-5-30 16:10

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

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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)