chin15

看了半天，若由我選擇，我還是會用樞紐
樞紐完成後，複製樞紐分析表，選擇性貼上值到另一個區塊
後續的作業就可以在這個區塊任意存取不受影響了。

dragonbx

因為這個公式已經寫差不多了~所以想說以這種方式完成
麻煩了~~

dragonbx

因為有寫巨集~用樞紐的話有辦法自動跑嗎??

chin15

不想用樞紐，用巨集也可以啊
資料大時用公式必定吃苦頭的

1. 
   下載 (37.34 KB)
   

   2011-5-6 15:19

複製代碼

dragonbx

請問該如何寫巨集呢?

我點選複製代碼貼上後得到以下答案

下載 (37.34 KB)
2 小時前

chin15

請問該如何寫巨集呢?

我點選複製代碼貼上後得到以下答案

下載 (37.34 KB)
2 小時前
dragonbx 發表於 2011-5-6 17:25

1. Private Sub CommandButton1_Click()
   
2.     Dim d As Object, d2 As Object, a, arr, i&, m&, r&
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d2 = CreateObject("scripting.dictionary")
   
5.     a = Range([a2], [b65536].End(3))
   
6.     ReDim arr(1 To UBound(a), 1 To 250)
   
7.     For i = 1 To UBound(a)
   
8.         If d(a(i, 1)) = "" Then
   
9.             m = m + 1
   
10.             d(a(i, 1)) = m
    
11.             d2(a(i, 1)) = 2
    
12.             arr(1, d(a(i, 1))) = a(i, 1): arr(2, d(a(i, 1))) = a(i, 2)
    
13.         Else
    
14.             d2(a(i, 1)) = d2(a(i, 1)) + 1
    
15.             arr(d2(a(i, 1)), d(a(i, 1))) = a(i, 2)
    
16.             r = IIf(r > d2(a(i, 1)), r, d2(a(i, 1)))
    
17.         End If
    
18.     Next
    
19.     [e:iv] = ""
    
20.     [f1].Resize(r, m) = arr
    
21.     ReDim arr(1 To r, 0)
    
22.     For i = 1 To r - 1
    
23.         arr(i, 0) = [b1] & i
    
24.     Next
    
25.     [e2].Resize(r - 1, 1) = arr
    
26. End Sub

複製代碼

dragonbx

可以了~~感謝大大的教學

97forum

真的是受教許多，由於很多Excel上面的功能或函數很少去使用它，除非在工作上經常會需求多種不同的功能時才會想辦法去解決，真的是所謂的"書到用時方恨少"。

Andy2483

回復 1# dragonbx


    謝謝論壇,謝謝各位前輩
後學藉此主題練習陣列與字典,請各位前輩再指導

20230315_2.zip (12.35 KB)

下載次數: 2

2023-3-15 14:25

執行前:

下載 (63.29 KB)

2023-3-15 14:25

執行結果:

下載 (77.28 KB)

2023-3-15 14:26

Option Explicit
Sub Test()
Dim Brr, Crr, Y, i&, R&, M&, T2%, C%, T1$
'↑宣告變數:(Brr,Crr,Y)是通用型變數,(i,R,M)是長整數變數,
'(T2,C)是短整數變數,T1是字串變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Set Brr = Sheets(1).UsedRange: Brr.Offset(0, 4).ClearContents
'↑令Brr這通用型變數是索引號1工作表有使用的儲存格,
'令Brr變數向右偏移4欄的儲存格內容清除
Brr = Brr: For i = 2 To UBound(Brr): Y(Val(Brr(i, 1))) = "": Next
'↑令Brr是二維陣列,以Brr變數值帶入
'設順迴圈!i從2到 Brr陣列縱向最大索引列號
'令i迴圈列第1欄Brr陣列值經轉化為數值當key,item是空字元,納入Y字典
ReDim Crr(1 To UBound(Brr), 1 To Y.Count + 1): Y.RemoveAll
'↑宣告Crr是二維陣列,縱向範圍(1到Brr陣列縱向最大索引列號)列,
'橫向範圍(1到Y字典key數量+1)欄
'清空Y字典
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2到 Brr陣列縱向最大索引號
   T1 = Val(Brr(i, 1)): T2 = Brr(i, 2)
   '↑令T1這字串變數是 i迴圈列第1欄Brr陣列值經轉化為數值的新字串
   If Not Y.Exists(T1 & "/C") Then
   '↑如果T1變數連接"/C"成的字串在Y字典裡沒有此key?
      C = C + 1: Y(T1 & "/C") = C: Crr(1, C + 1) = T1
      '↑令C這短整數變數累加1
      '令T1變數連接"/C"成的字串當key,item是 C變數,納入Y字典裡
      '令1列第(C變數+1)欄Crr陣列值是 T1變數
   End If
   R = Y(T1 & "/R"): R = R + 1: Y(T1 & "/R") = R
   '↑令R這長整數變數是 (T1變數連接"/R"成的字串查Y字典回傳item值):
   '令R變數累加1:令T1變數連接"/R"成的字串當key,item是R變數,放回Y字典
   If R > M Then M = R: Crr(M + 1, 1) = Brr(1, 2) & M
   '↑如果R變數大於 這M長整數變數!就令M變數是R變數值:
   '令(M變數+1)列第1欄Crr陣列值是 1列第2欄Brr陣列值連接M變數的新字串
   Crr(Y(T1 & "/R") + 1, Y(T1 & "/C") + 1) = T2
   '↑令(Y(T1 & "/R") + 1)列第(Y(T1 & "/C") + 1)欄Crr陣列值是 T2變數
   '(Y(T1 & "/R") + 1)列: T1變數連接"/R"成的字串查Y字典的item值+1 列
   '(Y(T1 & "/C") + 1)列: T1變數連接"/C"成的字串查Y字典的item值+1 欄
Next
Crr(1, 1) = Brr(1, 1)
'↑令1列第1欄Crr陣列值是 1列第1欄Brr陣列值
[E1].Resize(M + 1, C + 1) = Crr
'↑令[E1]擴展向下(M變數+1)列,向右擴展(C變數+1)欄,
'這擴展範圍儲存格值以Crr陣列值帶入
Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub