麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 如何加資料 [打印本頁]

作者: basarasy 時間: 2011-1-3 18:49 標題: 如何加資料

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

作者: Hsieh 時間: 2011-1-3 21:59

回復 1# basarasy

Sub Ex()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
For Each A In Range([A1], [A1].End(xlDown))
mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")
d(mystr) = d(mystr) + A.Offset(, 4).Value
d1(mystr) = Array(A.Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value, d(mystr))
Next
[H:L] = ""
[H1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items))
End Sub

複製代碼

如果把表格加上欄名稱，就可使用樞紐分析

作者: basarasy 時間: 2011-1-3 22:21

回復 2# Hsieh

感謝Hsieh大大.
大大用的碼很深><,很多都沒有見過.
請問Hsieh大大可以解說嗎?

作者: Hsieh 時間: 2011-1-3 22:50

回復 3# basarasy
這是很直觀的代碼

Sub Ex()
Dim A As Range '宣告變數為儲存格型態
Set d = CreateObject("Scripting.Dictionary") '設置字典物件
Set d1 = CreateObject("Scripting.Dictionary") '設置字典物件
For Each A In Range([A1], [A1].End(xlDown)) '在A欄作迴圈取得位置
mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",") '變數指定為A欄向右擴展成4欄大小的範圍以逗號連結的字串
d(mystr) = d(mystr) + A.Offset(, 4).Value '計算以mystr為關鍵字的累加
d1(mystr) = Array(A.Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value, d(mystr)) '以mystr為關鍵字加入項目，此項目為一陣列，陣列最後一個值為累加值
Next
[H:L] = "" '清空目標區
[H1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items)) '將字典物件內容以2次轉置(因為要轉成標準的二維陣列)寫入目標區
End Sub

複製代碼

作者: basarasy 時間: 2011-1-3 23:13

回復 4# Hsieh

謝謝大大
看完大大的說明以明白少少.
因為還未學習到設置字典物件,陣列的用法.
還有就是是否set做物件的變數,最後都要set Nothing?

作者: FAlonso 時間: 2011-1-3 23:13

這個dictionary究竟是什麼東西? 有什麼作用? 感覺很神秘,一般vba書都未必提及

作者: Hsieh 時間: 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說明檔

作者: asus103 時間: 2011-1-4 09:35

回復 4# Hsieh
請問
mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")
程式碼中兩次Transpose的意義是否是要將1~4欄的內容巧妙的轉成陣列，而無需使用FOR迴圈，以便JOIN成一字串?

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

作者: Hsieh 時間: 2011-1-4 11:14

回復 6# basarasy

釋放物件是好習慣
其實物件會隨著程序結束而自動釋放

作者: FAlonso 時間: 2011-1-4 12:58

本帖最後由 FAlonso 於 2011-1-4 20:26 編輯

Sub abc()
Dim myrange As Range, mystring(), count()
Dim i, j, k As Integer
Set myrange = Range("A1:D" & Range("A1").End(xlDown).Row) '計算字母串的總範圍
i = myrange.Cells.count / 4 '計算字母串的列數
ReDim mystring(i) '把mystring的array調較至字母串列數
ReDim count(i) '每一個字母串均設有一個計數器
For j = 1 To i
count(j) = 1 '每個字串均出現一次,所以設計數器為1
Next
For j = 1 To i
For k = 1 To 4
mystring(j) = mystring(j) + myrange.Cells(j, k) '把字串輸入mystring
Next '如mystring(1)是ASDF,mystring(2)是ASSS (請參考樓主excel的字母)
Next
For j = 1 To i - 1
For k = j + 1 To i
If count(j) = 0 Then
Exit For '計數器為0,即重覆字母刪掉,不需再檢查
End If
If mystring(j) = mystring(k) Then '比較mystring array中的字母串
mystring(k) = vbnullstring '把重覆的字母幹掉
count(j) = count(j) + 1 '相同的話,計數器加1
count(k)=0 '將重覆的字母的計數器給關掉
End If
Next
Next
Range("H1").Select
For j = 1 To i
If mystring(j) <> vbNullString Then '不是vbnullstring便抄錄在H欄
ActiveCell.Value = Cells(j, 1)
ActiveCell.Offset(, 1).Value = Cells(j, 2)
ActiveCell.Offset(, 2).Value = Cells(j, 3)
ActiveCell.Offset(, 3).Value = Cells(j, 4)
ActiveCell.Offset(, 4).Value = count(j)
ActiveCell.Offset(1).Activate
End If
Next
End Sub

複製代碼

希望高手評評我這個macro

作者: Hsieh 時間: 2011-1-4 13:10

完全看不懂妳邏輯
請將須求敘述清楚，實在無法從你錯誤的代碼，找出你的邏輯

作者: FAlonso 時間: 2011-1-4 20:38

我做了一個完整的程式,樓主可以試試,大家也可給意見
寫得真慢,40幾行花了一天時間

作者: Hsieh 時間: 2011-1-4 21:53

回復 10# FAlonso

Sub Ex()
On Error Resume Next
Dim Mystr(), MyCnt()
i = 1
Do Until Cells(i, 1) = ""
If IsError(Application.Match(Cells(i, 1) & "," & Cells(i, 2) & "," & Cells(i, 3) & "," & Cells(i, 4), Mystr, 0)) Then
ReDim Preserve Mystr(s)
ReDim Preserve MyCnt(s)
Mystr(s) = Cells(i, 1) & "," & Cells(i, 2) & "," & Cells(i, 3) & "," & Cells(i, 4)
MyCnt(s) = Cells(i, 5)
s = s + 1
Else
k = Application.Match(Cells(i, 1) & "," & Cells(i, 2) & "," & Cells(i, 3) & "," & Cells(i, 4), Mystr, 0)
MyCnt(k) = MyCnt(k - 1) + Cells(i, 5)
End If
i = i + 1
Loop
For i = 0 To s - 1
Cells(i + 1, 8).Resize(, 4) = Split(Mystr(i), ",")
Cells(i + 1, 12) = MyCnt(i)
Next
End Sub

複製代碼

作者: basarasy 時間: 2011-1-4 22:19

還有1個小問題想請教Hsieh大大的.
可否用 Range(cells(,),cells(,)) 同時Select 2個or多個地方?
Range(cells(a,b),cells(c,d)) + Range(cells(e,f),cells(g,h))

作者: linshin1999 時間: 2011-1-4 22:23

在VBE模式下有一個?號,就是在寫VBA有問是題時可以點一下問號,然後把不懂的打進去搜尋,通長都會得到答案.
如下就是 Scripting.Dictionary 搜尋出來的結果,

Dictionary 物件與 PERL 相關陣列一樣。可以存放任何型式的資料項目陣列。每個項目都是唯一的關鍵字。該關鍵字用來取出單個項目，通常是整數或字串，可以是存放除陣列以外的任何型別資料。

下面舉例說明了如何建立一個 Dictionary 物件：

Dim d '建立一個變數
Set d = CreateObject(Scripting.Dictionary)
d.Add "a", "Athens" '加入一些關鍵字和項目
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
...

因為說明檔是直接翻譯的所以文句很不順,以上文字有經過修改,但是目前說明檔仍然是學習Excel最簡便的工具,大家做參考.

作者: basarasy 時間: 2011-1-4 22:27

回復 15# linshin1999

變數要用Object嗎?
Dim d as Object ??

作者: FAlonso 時間: 2011-1-4 22:35

回復 basarasy
這是很直觀的代碼
Hsieh 發表於 2011-1-3 22:50

兩次使用application.transpose有點難解,數學上應該沒轉變,所謂的"標準二維陣列"是什麼

作者: FAlonso 時間: 2011-1-7 13:26

本帖最後由 FAlonso 於 2011-1-8 20:25 編輯

關於transpose問題....

例如excel有如下排列
A B C D
1  r
2  e
3  s
4  t

將一個column的字連串:
transpose一次

結果是r,e,s,t

Sub abc()
Dim mystring
mystring = Join(Application.Transpose(Range("A1:a4").Value), ",") '注意這裡是一個column串
Range("A10").Value = mystring
End Sub

複製代碼

將一個row的字連串:
transpose二次

A B C D
1 r t u i

Sub abc()
Dim mystring
mystring = Join(Application.Transpose(Application.Transpose(Range("A1:D1"))), ",") '注意這裡是一個row串
Range("A10").Value = mystring
End Sub

複製代碼

結果是r,t,u,i

今日做了一點詳細研究,是土法大鍊鋼
先把以下程式抄進VBA

Sub check()
Dim ar As Variant
Dim i As Integer
Set ar = [a1:a4] 'try [a1:d1] later
For i = 1 To 6
ar = Application.Transpose(ar)
Next
Set ar = Nothing
End Sub

複製代碼

打開檢視->區域變數視窗,再按F8,逐行執行,觀察ar陣的資料

先看[a1:a4],一個column的range
是一個2D陣列(看紅色圈子), variant(1 to 4,1 to 1)

transpose一次後,變成了一個1D陣列, variant(1 to 4),這個是可以進入join()程式的東東

不論再如何transpose,都只會重覆variant(1 to 4,1 to 1) -> variant(1 to 4) -> variant(1 to 4,1 to 1) 這個循環

再看[a1:d1](自己把程式修改),一個row的range
是一個2D陣列, variant(1 to 1,1 to 4),這裡不再print screen了,大家自己看看
transpose一次後,變成另外一個2D陣列,叫variant(1 to 4,1 to 1),這樣是不能進入join程式
transpose第二次,便變了variant(1 to 4),可以了!
但之後無論怎transpose,都只會重覆variant(1 to 4,1 to 1) -> variant(1 to 4) -> variant(1 to 4,1 to 1) 這個循環,永遠不會變回variant(1 to 1,1 to 4)這個設定

打個比喻,就等如一個2-D row的陣列,首先變了"類似"2-D column的形態,再變1-D array
而2-D column就馬上變了1-D array
這樣應該能夠解釋為什麼row要transpose多一次,但row為什麼要首先變成column形,不要問我

最後d1.items那行
看以下例子

Dim myrange As Range
Dim i As Integer, k
Set myobject = CreateObject("scripting.dictionary")
myobject("A") = Array(1, 2)
myobject("B") = Array(4, 5)
myobject("C") = Array(7, 8)
Set myrange = Worksheets("sheet2").Range("A1").Resize(3, 2)
k = myobject.items
k = Application.Transpose(Application.Transpose(k))
myrange = k

複製代碼

在完成myobject配置後,區域變數的顯示指該物件尚未是array(沒有那些variant(x,y),純粹是很散的架構)
把myobject.items叫出來,便看到k有variant(0,2)的1D形態(3個索引,"A","B","C")
打開k的"+"鍵,會看到k(0),k(1),k(2)各自都有variant(0,1)的1D形態(即每個索引中的兩個數字的表示)
transpose()一次,便會成一個variant(1 to 2,1 to 3)的2D陣列
其實此時已經可以貼上格子囉!試把resize(3,2)變成(2,3)看看!
不過因為我們想排成
   A    B
1 1    2
2 4    5
3 7       8
所以再transpose一次而已

作者: Hsieh 時間: 2011-1-7 16:06

回復 18# FAlonso
儲存格指定出來的範圍
不論是1列或多列
excel均將視為二維陣列
經過transpose函數轉置後才會得到正確的維數
所以當你的原陣列是以一維陣列儲存多個陣列成為多維陣列時
如
Dim Ay()
For i = 0 To 10
ReDim Preserve Ay(i)
Ay(i) = Array(i * 1, i * 2, i * 3, i * 4, i * 5)
Next
[A1].Resize(i, 5) = Application.Transpose(Application.Transpose(Ay))
Ay陣列元素是陣列
要以一次寫入就必須使用2次transpose

作者: FAlonso 時間: 2011-1-7 18:12

回復 19# Hsieh
那麼正確的維數其實是怎樣定義? 想來想去都想不通
在我的示範,Range("A1:A4")算不算是一個陣列?
為什麼打直的格子,一次transpose就可以,打橫的要兩次? 我試過打直的用兩次transpose,會有錯誤出現

還有

d(mystr) = d(mystr) + A.Offset(, 4).Value

複製代碼

這句是怎解釋,為什麼可以作累加的作用
是否dictionary自動就是array,不需declare(即像普通的變數要作x()這樣的宣告))?

希望H大解答

作者: Hsieh 時間: 2011-1-7 20:21

本帖最後由 Hsieh 於 2011-1-7 20:27 編輯

回復 20# FAlonso
首先我必須先佩服的求知態度
記得當初剛接觸陣列與dictionary物件時，也有著跟你相同的疑惑
但我就是不求甚解的個性，就把TRANSPOSE函數作為處理陣列問題的方法而已
今天遇到您提出疑問，那就讓我們一起來探討他的奧秘吧!
以下是我個人對陣列與dictionary的理解方式
提供您做參考
若有不是之處，還請各位前輩指正

1.Range("A1:A4")算不算是一個陣列?
是陣列，而且是二維陣列
以下列程式碼測試該陣列狀態

Sub Ex()
Dim j%, i%, Ar As Variant
On Error Resume Next
Ar = [A1:A4]
Do Until j > 2 'j為計算轉置次數的變數
MsgBox IIf(IsArray(Ar), "ar是陣列", "ar不是陣列") '是否為陣列
i = 1
Do Until Err.Number > 0
i = i + 1
k = UBound(Ar, i)
Loop
MsgBox "此陣列為" & i - 1 & "維陣列" & Chr(10) & "被轉置" & j & "次" '第一維上限(列數)
Err.Clear
Ar = Application.Transpose(Ar)
j = j + 1
Loop
End Sub

複製代碼

2.為什麼打直的格子,一次transpose就可以,打橫的要兩次?
那是因為join的引數必須是一維陣列

3.d(mystr) = d(mystr) + A.Offset(, 4).Value這句是怎解釋,為什麼可以作累加的作用?
因為dictionary物件，你可以直接視為陣列，當中的mystr就是索引值(一般陣列會是數值,在此是除了陣列型態以外的任何資料型態)，代表此物見某個元素的指定索引
d(mystr)就是d這個物件的mystr位置的那個元素
d(mystr) = d(mystr) + A.Offset(, 4).Value
變數(新值)=變數(原值)+常數
就好比一個變數了，所以自然就能計算累加值

作者: FAlonso 時間: 2011-1-7 23:05

第二個問題先擱下不表
第三個問題是否指先把mystr注冊在dictionary的index,d(mystr),而該index的default資料為 = 0(即 d(mystr)=0), 再引以offset(,4)計數?還有dictionary照理說應該是幾D array?

感覺愈來愈近真相!

作者: Hsieh 時間: 2011-1-7 23:39

Dictionary物件當加入KEY的同時即產生對應該KEY的值為Empty的初始值
整個物件當可視為二維陣列
其第一維則是該物件的數量
其第二維則是該物件的keys與items
該陣列大小表示如下:
ThisArray(d.count,2)
但你無法以INDEX指定該陣列
因為這只是將其視為二維陣列
但實際上他是2個縱列的陣列合起來
所以一般應用上會以其Key直接指定到對應的Item

作者: b9208 時間: 2011-1-8 07:37

感謝各位先進
之前針對dictionary & transpose 總是不太了解
看完本文章後，總算比較了解其用法了。

作者: linshin1999 時間: 2011-1-8 11:22

本帖最後由 linshin1999 於 2011-1-8 11:26 編輯

回復 16# basarasy

變數要用Object嗎?
Dim d as Object ??

Dim d '建立一個變數
Set d = CreateObject(Scripting.Dictionary)

VBA 中變數的宣告不明確說明型別為何時,它的型別就是 Variant 它的意思就是什麼型態都可以,
1)有好處:就 Scripting.Dictionary 來講,它要處厘跟著來的陣列所以它的型別會跟著後面的陣列跑,它的型別就一定要是 Variant ,如果没有 variant 這個型別, Dictionary 就不存在了 .
2)有缺點:就是不明確,對於習慣明確型別的人會很不習慣,我也是這樣.

今天再回頭讀 Hsieh 版主和 TAlonso 精彩的論述,才注意到有這則回復,真不好意思.

回復 24# b9208

太精彩了,我也來加碼.

作者: Hsieh 時間: 2011-1-8 13:18

回復 25# linshin1999
dim d as object
這是正確宣告，dictionary他是個物件所以宣告為物件沒錯
dictionary這個物件不會因為他的key與item產生資料型態變化
你可將此物件看成一個容器，此容器的內容物並不會改變此容器本身的性質

所以VBA說明中提到
dictionary物件，其key式除了陣列以外的任何資料型態，而item則可為任何形態的資料。
一個關鍵字可對應任何的資料，這是此物件的特性。

作者: FAlonso 時間: 2011-1-8 14:10

回復 26# Hsieh
多謝H大指點,現在終於完全解通了
另外在#18,我新增了一些筆記,希望以後對他人有用

作者: linshin1999 時間: 2011-1-8 15:06

怎麼講呢?就是一點點加一點點加,然後就懂了,謝謝各位,放假了大家都還在努力,FAlonso台灣好冷,那裡還好吧!

作者: b9208 時間: 2011-1-9 11:43

linshin1999 兄

於#18對transpos說明非常詳細
建議對transpos變化不了解的，可以前往拜讀。
非常感謝

作者: linshin1999 時間: 2011-1-9 23:30

回復 29# b9208

我是後學, 論壇上談的都是我進步的糧食,會很珍惜的,這個論壇真的幫助我很多,借此再說聲謝謝大家!!:D

作者: Andy2483 時間: 2023-3-29 11:10

回復 2# Hsieh

謝謝論壇,謝謝前輩
後學藉此帖學習到JOIN() 儲存格值需要經過兩次轉置,讓變成一維陣列,才能連接成新字串
學習心得如下,請前輩再指教

Option Explicit
Sub Ex()
Dim A As Range, d, d1, mystr$
'↑宣告變數:A是儲存格變數,(d,d1)是通用型變數,mystr是字串變數
Set d = CreateObject("Scripting.Dictionary")
'↑令d這通用變數是字典
Set d1 = CreateObject("Scripting.Dictionary")
'↑令d1這通用變數是字典
For Each A In Range([A1], [A1].End(xlDown))
'↑設逐項迴圈!令A這儲存格變數是範圍儲存格裡的一格,
'範圍儲存格:本表[A1]到 [A]往下找最後一個有內容儲存格,這範圍儲存格
mystr = Join(Application.Transpose(Application.Transpose(A.Resize(, 4))), ",")
'↑令mystr這字串變數是 A變數(儲存格)向右擴展4欄儲存格經2次轉置後,
'以 ","連接成的新字串
d(mystr) = d(mystr) + A.Offset(, 4).Value
'↑令以mystr變數為key,item是 item自身 + A變數向右偏移4格儲存格(E欄)值,
'納入d字典
d1(mystr) = Array(A.Value, A.Offset(, 1).Value, A.Offset(, 2).Value, _
A.Offset(, 3).Value, d(mystr))
'↑令以mystr變數為key,item是陣列(A變數(含)右側4個儲存格值,
'以mystr變數查d字典的item值)
Next
[H:L] = ""
'↑令[H:L]儲存格值是空字元
[H1].Resize(d1.Count, 5) = Application.Transpose(Application.Transpose(d1.items))
'↑令[H1]擴展向下d1字典key數列,擴展向右5欄,這範圍儲存格值以d1字典items轉置兩次帶入
End Sub

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)