准提部林

Sub TEST()
Dim Arr, Brr, xD, Dn&, T$, N&, i&, j%
Arr = Range([A1], Cells(Rows.Count, 1).End(xlUp)(1, 5))
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
　　For j = 1 To 4: T = T & "/" & Arr(i, j): Next
　　　　Dn = xD(T)
　　　　If Dn = 0 Then
　　　　　N = N + 1: Dn = N: xD(T) = N
　　　　　For j = 1 To 4: Brr(Dn, j) = Arr(i, j): Next
　　　　End If
　　　　Brr(Dn, 5) = Brr(Dn, 5) + Val(Arr(i, 5)): T = ""
Next i
If N > 0 Then [H2].Resize(N, 5) = Brr
End Sub

Xl0000035.rar (16.73 KB)

下載次數: 11

2016-10-5 21:00

　

准提部林

回復 5# starbox520


Xl0000160_v1.rar (21.03 KB)

下載次數: 9

2016-10-7 17:48

准提部林

回復 10# starbox520


Xl0000160_v2.rar (21.78 KB)

下載次數: 5

2016-10-7 21:12

准提部林

回復 13# starbox520


完全看不懂~~~

准提部林

回復 15# starbox520

1. Sub TEST()
   
2. Dim Arr, Brr, xD, Dn&, T$, N&, i&, j%
   
3. Arr = Range([工作表1!A1], [工作表1!A1].Cells(Rows.Count, 1).End(xlUp)(1, 5))
   
4. Set xD = CreateObject("Scripting.Dictionary")
   
5. ReDim Brr(1 To UBound(Arr), 1 To 8)
   
6. For i = 2 To UBound(Arr)
   
7.     T = Arr(i, 1) & "|" & Arr(i, 3) & "|" & Arr(i, 4)
   
8.     Dn = xD(T)
   
9.     If Dn = 0 Then
   
10.        N = N + 1: Dn = N: xD(T) = N
    
11.        For j = 1 To 3: Brr(Dn, j) = Arr(i, Array(1, 3, 4)(j - 1)): Next
    
12.     End If
    
13.     j = Int(InStr("---BK-VM-TR-PK-", "-" & Split(Arr(i, 2), "_")(1) & "-") / 3)
    
14.     If j > 0 Then
    
15.        Brr(Dn, j + 3) = Brr(Dn, j + 3) + Arr(i, 5)
    
16.        Brr(Dn, 8) = Brr(Dn, 8) + Arr(i, 5)
    
17.     End If
    
18. Next i
    
19. If N = 0 Then Exit Sub
    
20. With Sheets("工作表3")
    
21.      .UsedRange.Offset(1, 0).Clear
    
22.      .[A2].Resize(N, 8) = Brr
    
23.      Application.Goto .[A1]
    
24. End With
    
25. End Sub

複製代碼

Xl0000164.rar (23.32 KB)

下載次數: 9

2016-10-10 13:39

准提部林

回復 17# starbox520


MsgBox Split("5F_BK", "_")(1)  '>>>  取得"_"右方的"BK"

MsgBox InStr("---BK-VM-TR-PK-", "-" & "BK" & "-")   '>>> 等于 3
MsgBox Int(3 / 3)
MsgBox InStr("---BK-VM-TR-PK-", "-" & "VM" & "-")   '>>> 等于 6
MsgBox Int(6 / 3)
MsgBox InStr("---BK-VM-TR-PK-", "-" & "PK" & "-")   '>>> 等于 12
MsgBox Int(12 / 3)
MsgBox InStr("---BK-VM-TR-PK-", "-" & "" & "-")   '>>> 等于 1
MsgBox Int(1 / 3)
MsgBox InStr("---BK-VM-TR-PK-", "-" & "HG" & "-")   '>>> 等于 0
MsgBox Int(0 / 3)

這樣就可以知道數值放在哪欄, j + 3 是因前三欄已使用

准提部林

回復 17# starbox520


也可用這：
M = Application.Match(Split(Arr(i, 2), "_")(1), [工作表3!D1:G1], 0)
If IsNumeric(M) Then
　　Brr(Dn, M + 3) = Brr(Dn, M + 3) + Arr(i, 5)
　　Brr(Dn, 8) = Brr(Dn, 8) + Arr(i, 5)
End If

准提部林

回復 22# starbox520

還是看不懂如何做!
何況office版本不同, 物件轉成舊版時,listbox無法使用!!!