返回列表 上一主題 發帖

[發問] 資料整理

chin15

帖子
227 
主題
3 
精華
1 
積分
273 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
女 
註冊時間
2011-3-22 
最後登錄
2013-1-29 
1# 跳轉到 »
發表於 2011-5-6 12:54 | 顯示全部帖子
看了半天，若由我選擇，我還是會用樞紐
樞紐完成後，複製樞紐分析表，選擇性貼上值到另一個區塊
後續的作業就可以在這個區塊任意存取不受影響了。

TOP

chin15

帖子
227 
主題
3 
精華
1 
積分
273 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
女 
註冊時間
2011-3-22 
最後登錄
2013-1-29 
2#
發表於 2011-5-6 15:19 | 顯示全部帖子
不想用樞紐，用巨集也可以啊
資料大時用公式必定吃苦頭的
  1. a.gif
複製代碼

TOP

chin15

帖子
227 
主題
3 
精華
1 
積分
273 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
女 
註冊時間
2011-3-22 
最後登錄
2013-1-29 
3#
發表於 2011-5-6 20:26 | 顯示全部帖子
請問該如何寫巨集呢?

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

下載 (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
複製代碼

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大，小人氣大。
返回列表 上一主題