[發問] 將多筆同單號的資料放入一個儲存格內,資料不重複及多條件加總

yliu

請問版上高手,
1.請問有可能做到將多筆同單號的資料放入一個儲存格內,然後資料不重複(如圖一)

下載 (95.54 KB)

2013-7-26 22:16

2.圖二 的表如何寫加總VBA?

下載 (62.18 KB)

2013-7-26 22:17

Report.zip (6.78 KB)

下載次數: 15

2013-7-26 22:17

GBKEE

回復 1# yliu
試試看

1. Option Explicit
   
2. Sub EX_1()   '表1的程式
   
3.     Dim 訂單號碼 As String, 請購單號 As String, 請購廠商 As String
   
4.     Dim AR(1 To 6), i As Integer
   
5.     With Sheets("report")
   
6.         訂單號碼 = .[B5]
   
7.         請購單號 = .[D5]
   
8.         請購廠商 = .[B6]
   
9.         With Sheets("final")
   
10.             i = 2
    
11.             Do While .Cells(i, "A") <> ""
    
12.                 If .Cells(i, "v").Value = 訂單號碼 And .Cells(i, "F") = 請購單號 And .Cells(i, "L") = 請購廠商 Then
    
13.                     AR(1) = .Cells(i, "j")                      '品名
    
14.                     AR(2) = AR(2) & IIf(AR(2) = "", "", ",") & .Cells(i, "k") '規格
    
15.                     AR(3) = .Cells(i, "i")                      '會計科目
    
16.                     AR(4) = .Cells(i, "b")                      '採購性質
    
17.                     AR(5) = AR(5) + .Cells(i, "m")                    'User請購價
    
18.                     AR(6) = .Cells(i, "c")                  '採購類別
    
19.                 End If
    
20.                 i = i + 1
    
21.             Loop
    
22.         End With
    
23.         .[B7] = AR(1)
    
24.         .[B8] = AR(2)
    
25.         .[B9] = AR(3)
    
26.         .[D9] = AR(4)
    
27.         .[B10] = AR(5)
    
28.         .[D10] = AR(6)
    
29.      End With
    
30. End Sub
    
31. Sub EX_2()  '表1的程式
    
32.     Dim d As Object, KEY, i As Integer, AR(), A(1 To 4), 訂單號碼 As String
    
33.     Set d = CreateObject("SCRIPTING.DICTIONARY")                   '字典物件 Scripting.Dictionary
    
34.     訂單號碼 = Sheets("report").[B5]
    
35.     With Sheets("record")
    
36.         .AutoFilterMode = False                                     '取消 工作表的自動篩選
    
37.             i = 2
    
38.             Do While .Cells(i, "A") <> ""
    
39.                 If .Cells(i, "P").Value = 訂單號碼 Then             '比對 訂單號碼
    
40.                     If d.exists(.Cells(i, "C").Value) = False Then d(.Cells(i, "C").Value) = .Cells(i, "C")
    
41.                 End If
    
42.                 i = i + 1
    
43.             Loop
    
44.             ReDim AR(1 To d.Count)                                  '重置陣列的元素上限=字典物件的計數(Count)
    
45.            .Range("A1").AutoFilter 16, 訂單號碼                     'AutoFilter 自動篩選 第16欄 指定條件值=訂單號碼
    
46.            i = 1
    
47.            For Each KEY In d.KEYS
    
48.             .Range("A1").AutoFilter 3, KEY                          'AutoFilter 自動篩選 第3欄 指定條件值=字典物件的KEY
    
49.             A(1) = KEY                                                             '採購廠商
    
50.             A(2) = Application.Sum(.Range("M:M").SpecialCells(xlCellTypeVisible))  '第1次議價
    
51.             A(3) = Application.Sum(.Range("N:N").SpecialCells(xlCellTypeVisible))  '第2次議價
    
52.             A(4) = Application.Sum(.Range("O:O").SpecialCells(xlCellTypeVisible))  '第3次議價
    
53.             AR(i) = A
    
54.             i = i + 1
    
55.         Next
    
56.     End With
    
57.     Sheets("report").[B13].Resize(4, 3) = Application.WorksheetFunction.Transpose(AR) '導入
    
58. End Sub

複製代碼

yliu

回復 2# GBKEE

感謝GBKEE的解答.程式碼可以使用,
只是想再問一下, 有沒有可能可以做到讀取第1筆序號的品名時,就放入"report" 儲存格[B7]，讀取第2筆序號的品名時,如果品名與第1筆序號的品名不一樣時也放入"report" 儲存格[B7]，讀取第3筆序號的品名時如果品名與第1筆序號或第2筆序號品名相同時,就不放入"report" 儲存格[B7].
還是說, 只能做到就只能夠取最後一筆資料放入"report" 儲存格[B7]，要不然就是3筆序號的資料皆放入儲存格(如規格的欄位,儲存格[B8]那樣).
麻煩你了,謝謝!

GBKEE

回復 3# yliu

1. Do While .Cells(i, "A") <> ""
   
2.                 If .Cells(i, "v").Value = 訂單號碼 And .Cells(i, "F") = 請購單號 And .Cells(i, "L") = 請購廠商 Then
   
3.                       '**********************************************************
   
4.                     If AR(1) = "" Then
   
5.                         AR(1) = .Cells(i, "J")                                                     '品名
   
6.                     Else
   
7.                         M = Application.Match(.Cells(i, "J"), Split(AR(1), ","), 0)                 '尋找相同的品名
   
8.                         If IsError(M) Then AR(1) = AR(1) & "," & .Cells(i, "J")                     '尋找不到時 Match傳回 錯誤值
   
9.                     End If
   
10.                  '*********************************************************   
    
11.                     AR(2) = AR(2) & IIf(AR(2) = "", "", ",") & .Cells(i, "k") '規格
    
12.                     AR(3) = .Cells(i, "i")                      '會計科目
    
13.                     AR(4) = .Cells(i, "b")                      '採購性質
    
14.                     AR(5) = AR(5) + .Cells(i, "m")                    'User請購價
    
15.                     AR(6) = .Cells(i, "c")                  '採購類別
    
16.                 End If
    
17.                 i = i + 1
    
18.             Loop

複製代碼

yliu

回復 4# GBKEE

感謝GBKEE版大,
你實在太厲害了, 這程式碼完全符合我想要的東西,萬分感謝~

yliu

回復 4# GBKEE

GBKEE版大,
“final”工作表資料只有1筆訂單號碼時,可以執行
後來,我加了第2筆訂單號碼資料後,執行卻出現:
執行階段錯誤9
陣列索引超出範圍
偵錯在:
ReDim AR2(1 To d.Count)       '重置陣列的元素上限=字典物件的計數(Count)

請問是什麼原因?

GBKEE

回復 6# yliu
上傳檔案看看

yliu

回復 7# GBKEE

GBKEE版大,
麻煩請你幫我看一下檔案,問題出在哪裡. 謝謝!

Report.zip (23.22 KB)

下載次數: 8

2013-8-1 23:38

GBKEE

回復 8# yliu
檢查一下:dic的個數,如為0時要有if 的判斷式.

1. MsgBox dic.Count            
   
2.             ReDim AR2(1 To dic.Count)                                  '重置陣列的元素上限=字典物件的計數(Count)

複製代碼

yliu

回復 9# GBKEE

謝謝GBKEE的指導,
加了 If dic.count=0 的判斷式,已經ok了,謝謝.