12
返回列表 上一主題 發帖

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

yliu

帖子
49 
主題
8 
精華
0 
積分
63 
點名
0  
作業系統
windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
女 
來自
高雄 
註冊時間
2013-4-8 
最後登錄
2013-10-30 

論壇贊助勳章
8# 跳轉到 »
發表於 2013-8-1 23:38 | 只看該作者
回復 7# GBKEE

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

Report.zip (23.22 KB)
learner

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2013-8-1 14:57 | 只看該作者
回復 6# yliu
上傳檔案看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

yliu

帖子
49 
主題
8 
精華
0 
積分
63 
點名
0  
作業系統
windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
女 
來自
高雄 
註冊時間
2013-4-8 
最後登錄
2013-10-30 

論壇贊助勳章
6#
發表於 2013-8-1 13:41 | 只看該作者
回復 4# GBKEE

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

請問是什麼原因?
learner

TOP

yliu

帖子
49 
主題
8 
精華
0 
積分
63 
點名
0  
作業系統
windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
女 
來自
高雄 
註冊時間
2013-4-8 
最後登錄
2013-10-30 

論壇贊助勳章
5#
發表於 2013-7-31 00:11 | 只看該作者
回復 4# GBKEE

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2013-7-30 06:43 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

yliu

帖子
49 
主題
8 
精華
0 
積分
63 
點名
0  
作業系統
windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
女 
來自
高雄 
註冊時間
2013-4-8 
最後登錄
2013-10-30 

論壇贊助勳章
3#
發表於 2013-7-29 23:30 | 只看該作者
回復 2# GBKEE

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-7-27 12:35 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 多做多得。少做多失。
12
返回列表 上一主題