12
返回列表 上一主題 發帖

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

97forum
　暱稱: Tiger97

中學生Rank: 2

帖子
71 
主題
16 
精華
0 
積分
111 
點名
107  
作業系統
Windows 10 
軟體版本
Office 2016 
閱讀權限
20 
性別
男 
註冊時間
2011-3-7 
最後登錄
2025-5-17 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章
11# 跳轉到 »
發表於 2013-8-12 10:29 | 只看該作者
回復  GBKEE

謝謝GBKEE的指導,
加了 If dic.count=0 的判斷式,已經ok了,謝謝.
yliu 發表於 2013-8-11 15:01


不好意思由於我是新手，不知 YLiu是否可將您程式碼提供下載供參考！

TOP

yliu

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

論壇贊助勳章
12#
發表於 2013-8-14 23:34 | 只看該作者
回復 11# 97forum

Report.zip (24.77 KB) 檔案附上, 我也是新手, 所以沒有修改的很好, 但至少可以Run.
learner

TOP

yliu

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

論壇贊助勳章
13#
發表於 2013-8-14 23:48 | 只看該作者
回復 9# GBKEE
    GBKEE版大,
不好意思, 又出現另一個問題, 若是詢價廠商只有2家時, 無第3家廠商, 會出現#NA符號(如圖), 請問如何讓它是空白的?

Report.zip (24.72 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兔年全勤獎章
14#
發表於 2013-8-15 16:01 | 只看該作者
回復 13# yliu
  1.   ReDim AR2(1 To dic.Count)
  2.             '重置陣列的元素上限=字典物件的計數(Count)
  3.            .Range("A1").AutoFilter 16, 訂單號碼2                     'AutoFilter 自動篩選 第16欄 指定條件值=訂單號碼
  4.            i2 = 1
  5.            For Each KEY In dic.Keys
  6.                 .Range("A1").AutoFilter 3, KEY                          'AutoFilter 自動篩選 第3欄 指定條件值=字典物件的KEY
  7.                 A(1) = KEY                                                             '採購廠商
  8.                 A(2) = Application.Sum(.Range("M:M").SpecialCells(xlCellTypeVisible))  '第1次議價 '已用範圍的最後一個儲存格
  9.                 A(3) = Application.Sum(.Range("N:N").SpecialCells(xlCellTypeVisible))  '第2次議價 '已用範圍的最後一個儲存格
  10.                 A(4) = Application.Sum(.Range("O:O").SpecialCells(xlCellTypeVisible))  '第3次議價 '已用範圍的最後一個儲存格
  11.                 AR2(i2) = A
  12.                 i2 = i2 + 1
  13.             Next
  14.     End With
  15.     Sheets("report").[B13].Resize(4, dic.Count) = Application.WorksheetFunction.Transpose(AR2)  '導入
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

yliu

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

論壇贊助勳章
15#
發表於 2013-8-17 23:47 | 只看該作者
回復 14# GBKEE

謝謝GBKEE版大,已經解決了.
learner

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
16#
發表於 2013-8-18 09:21 | 只看該作者
本帖最後由 c_c_lai 於 2013-8-18 09:22 編輯

回復 15# yliu
將你目前的 Report 予以稍稍整理一下，方便閱讀及縮小(精簡)程式碼。
供你參考與應用：
  1. Private Sub ComboBox1_Change()
  2.     Dim d As Object, j As Integer
  3.    
  4.     Sheets("report").Unprotect ("789456123")
  5.    ClearFlds
複製代碼
  1.         If dic.Count = 0 Then
  2.             MsgBox "沒有議價資料"
  3.             ClearFlds
  4.            Exit Sub
  5.         End If
複製代碼
  1. Sub ClearFlds()
  2.     With Sheets("report")
  3.         ' .Cells(5, 2) = ""
  4.         ' .Cells(6, 2) = ""
  5.         ' .Cells(7, 2) = ""
  6.         ' .Cells(8, 2) = ""
  7.         ' .Cells(9, 2) = ""
  8.         ' .Cells(10, 2) = ""
  9.         ' .Cells(13, 2) = ""
  10.         ' .Cells(14, 2) = ""
  11.         ' .Cells(15, 2) = ""
  12.         ' .Cells(16, 2) = ""
  13.         ' .Cells(18, 2) = ""
  14.         ' .Cells(19, 2) = ""
  15.         ' .Cells(20, 2) = ""
  16.         ' .Cells(21, 2) = ""
  17.         .Range("B5:B10") = ""
  18.         .Range("B13:B21") = ""
  19.    
  20.         ' .Cells(13, 3) = ""
  21.         ' .Cells(14, 3) = ""
  22.         ' .Cells(15, 3) = ""
  23.         ' .Cells(16, 3) = ""
  24.         .Range("C13:C16") = ""
  25.    
  26.         .Cells(5, 4) = ""
  27.         ' .Cells(9, 4) = ""
  28.         ' .Cells(10, 4) = ""
  29.         .Range("D9:D10") = ""
  30.    
  31.         ' .Cells(13, 4) = ""
  32.         ' .Cells(14, 4) = ""
  33.         ' .Cells(15, 4) = ""
  34.         ' .Cells(16, 4) = ""
  35.         ' .Cells(20, 4) = ""
  36.         ' .Cells(21, 4) = ""
  37.         .Range("D13:D21") = ""
  38.     End With
  39. End Sub
複製代碼
ReportB.rar (23.43 KB)

TOP

yliu

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

論壇贊助勳章
17#
發表於 2013-8-18 20:28 | 只看該作者
回復 16# c_c_lai
謝謝c c lai的指導
learner

TOP

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