准提部林

回復 10# starbox520


Xl0000160_v2.rar (21.78 KB)

下載次數: 5

2016-10-7 21:12

starbox520

回復 11# 准提部林


    回准提大大
    我又發現新問題了
    如果是加機制進去像工作表3把表一  
    A,C,D如果相同就算一筆資料(已在表一 以人工篩選方法判斷...)
   然後B欄做歸類   形成工作表3要的項目
   
    Xl000040_EX2.rar (30.24 KB)

下載次數: 3

2016-10-10 01:10

准提部林

回復 13# starbox520


完全看不懂~~~

starbox520

回復 14# 准提部林


    回大大像這樣
    以橘色區塊為例
     A.C.D資料相符
     再去分出他的B欄 形成另一張圖
   
   

下載 (7.54 KB)

2016-10-10 11:31

下載 (5.32 KB)

2016-10-10 11:31

下載 (13.44 KB)

2016-10-10 11:35

准提部林

回復 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

starbox520

回復 16# 准提部林

    大大這段
    j = Int(InStr("---BK-VM-TR-PK-", "-" & Split(Arr(i, 2), "_")(1) & "-") / 3)

    還有這段
   Brr(Dn, j + 3) = Brr(Dn, j + 3) + Arr(i, 5)

   可以說明一下嗎    太厲害了><"想知道這是怎麼思考的

准提部林

回復 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

starbox520

回復 19# 准提部林


    瞭解了
    謝謝大大教學XD
    又學到了一課

starbox520

回復 19# starbox520


    回大大有辦法把您做的結果顯示在清單方塊做動作嗎
    不好意思問題有點多 == ""
    檔案內有細項說明><
  
   Xl000088.rar (96.48 KB)

下載次數: 8

2016-10-12 00:34