1234
返回列表 上一主題 發帖

[發問] 如何加資料

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-1-3 18:49 | 只看該作者

[發問] 如何加資料

請問大大有方法可以在同一地方把A,B,C,D 一樣資料的E加起來嗎?

BOOK1.rar (7.42 KB)

收藏 分享
50 字節以內
不支持自定義 Discuz! 代碼

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
280  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2011-1-3 21:59 | 只看該作者
回復 1# basarasy
  1. Sub Ex()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. For Each A In Range([A1], [A1].End(xlDown))
  6. mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")
  7. d(mystr) = d(mystr) + A.Offset(, 4).Value
  8. d1(mystr) = Array(A.Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value, d(mystr))
  9. Next
  10. [H:L] = ""
  11. [H1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items))
  12. End Sub
複製代碼
如果把表格加上欄名稱，就可使用樞紐分析
學海無涯_不恥下問

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
3#
發表於 2011-1-3 22:21 | 只看該作者
回復 2# Hsieh

感謝Hsieh大大.
大大用的碼很深><,很多都沒有見過.
請問Hsieh大大可以解說嗎?
50 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
280  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2011-1-3 22:50 | 只看該作者
回復 3# basarasy
這是很直觀的代碼
  1. Sub Ex()
  2. Dim A As Range  '宣告變數為儲存格型態
  3. Set d = CreateObject("Scripting.Dictionary")  '設置字典物件
  4. Set d1 = CreateObject("Scripting.Dictionary")  '設置字典物件
  5. For Each A In Range([A1], [A1].End(xlDown))  '在A欄作迴圈取得位置
  6. mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")  '變數指定為A欄向右擴展成4欄大小的範圍以逗號連結的字串
  7. d(mystr) = d(mystr) + A.Offset(, 4).Value  '計算以mystr為關鍵字的累加
  8. d1(mystr) = Array(A.Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value, d(mystr))  '以mystr為關鍵字加入項目，此項目為一陣列，陣列最後一個值為累加值
  9. Next
  10. [H:L] = ""  '清空目標區
  11. [H1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items))  '將字典物件內容以2次轉置(因為要轉成標準的二維陣列)寫入目標區
  12. End Sub
複製代碼
學海無涯_不恥下問

TOP

basarasy

帖子
287 
主題
65 
精華
0 
積分
357 
點名
0  
作業系統
xp 
軟體版本
OFFIC 2007 
閱讀權限
20 
註冊時間
2010-6-4 
最後登錄
2015-8-19 
5#
發表於 2011-1-3 23:13 | 只看該作者
回復 4# Hsieh

謝謝大大
看完大大的說明以明白少少.
因為還未學習到  設置字典物件,陣列 的用法.
還有就是  是否set做物件 的變數,最後都要set Nothing?
50 字節以內
不支持自定義 Discuz! 代碼

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
6#
發表於 2011-1-3 23:13 | 只看該作者
這個dictionary究竟是什麼東西? 有什麼作用? 感覺很神秘,一般vba書都未必提及
80 字節以內
不支持自定義 Discuz! 代碼

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
280  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2011-1-3 23:33 | 只看該作者
本帖最後由 Hsieh 於 2011-1-3 23:35 編輯

回復 6# FAlonso

http://forum.twbts.com/thread-20-1-1.html
http://forum.twbts.com/viewthread.php?tid=2287&extra=pageD1&page=2
這裡有初步的說明，要了解其屬性及方法請參閱VBA說明檔
學海無涯_不恥下問

TOP

asus103

帖子
77 
主題
11 
精華
0 
積分
118 
點名
0  
作業系統
winXP 
軟體版本
office2007 
閱讀權限
20 
性別
男 
註冊時間
2010-12-24 
最後登錄
2011-3-2 
8#
發表於 2011-1-4 09:35 | 只看該作者
回復 4# Hsieh
請問
mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")
程式碼中兩次Transpose的意義是否是要將1~4欄的內容巧妙的轉成陣列，而無需使用FOR迴圈，以便JOIN成一字串?

研讀超級版主的程式碼總會有令人驚艷的surprise
ASUS

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
280  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2011-1-4 11:14 | 只看該作者
回復 6# basarasy


    釋放物件是好習慣
其實物件會隨著程序結束而自動釋放
學海無涯_不恥下問

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
10#
發表於 2011-1-4 12:58 | 只看該作者
本帖最後由 FAlonso 於 2011-1-4 20:26 編輯
  1. Sub abc()
  2. Dim myrange As Range, mystring(), count()
  3. Dim i, j, k As Integer
  4. Set myrange = Range("A1:D" & Range("A1").End(xlDown).Row)   '計算字母串的總範圍
  5. i = myrange.Cells.count / 4        '計算字母串的列數

  7. ReDim mystring(i)          '把mystring的array調較至字母串列數
  8. ReDim count(i)             '每一個字母串均設有一個計數器

  10. For j = 1 To i
  11. count(j) = 1   '每個字串均出現一次,所以設計數器為1
  12. Next

  14. For j = 1 To i      
  15. For k = 1 To 4
  16. mystring(j) = mystring(j) + myrange.Cells(j, k)   '把字串輸入mystring
  17. Next   '如mystring(1)是ASDF,mystring(2)是ASSS (請參考樓主excel的字母)
  18. Next

  20. For j = 1 To i - 1
  21. For k = j + 1 To i

  23. If count(j) = 0 Then
  24. Exit For                      '計數器為0,即重覆字母刪掉,不需再檢查
  25. End If

  27. If mystring(j) = mystring(k) Then     '比較mystring array中的字母串
  28. mystring(k) = vbnullstring   '把重覆的字母幹掉
  29. count(j) = count(j) + 1      '相同的話,計數器加1
  30. count(k)=0   '將重覆的字母的計數器給關掉
  31. End If  
  32. Next                                                
  33. Next     

  35. Range("H1").Select
  36. For j = 1 To i
  37. If mystring(j) <> vbNullString Then       '不是vbnullstring便抄錄在H欄
  38. ActiveCell.Value = Cells(j, 1)
  39. ActiveCell.Offset(, 1).Value = Cells(j, 2)
  40. ActiveCell.Offset(, 2).Value = Cells(j, 3)
  41. ActiveCell.Offset(, 3).Value = Cells(j, 4)
  42. ActiveCell.Offset(, 4).Value = count(j)
  43. ActiveCell.Offset(1).Activate
  44. End If
  45. Next

  47. End Sub
複製代碼
希望高手評評我這個macro
80 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 愛不是要求對方，而是要由自身的付出。
1234
返回列表 上一主題