請問如何將FORMULAR 轉寫成VBA??

cdcc

Date        Description         Amount        New Category                       
1/5/2010         PRC Salaries         71,904         Payroll in PRC                Criteria                        Type
1/5/2010        HK Salaries         92,129         Payroll in HK                PRC Salaries        Payroll in PRC
7/6/2010        EE Transfer 2010/01 73,038         Fund Transfer                HK Salaries        Payroll in HK


CELL D4  = {INDEX(G:G,LARGE(IF(ISERROR(FIND($F$5:$F$8,$B4)),0,ROW($F$5:$F$8)),1))}

因為大量DATA, 所以FORMULAR 運算速度比較慢.

請問如何判斷範圍, 作出計算?

謝謝

chin15

最好上傳實際文件
這樣排版看不出資料位置

cdcc

最好上傳實際文件
這樣排版看不出資料位置
chin15 發表於 2011-5-11 23:03

   已經上傳文件

   希望大家幫忙解答

Hsieh

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. For Each a In Range([F5], [F65536].End(xlUp))
   
4.    d(a & "") = a.Offset(, 1).Value
   
5. Next
   
6. For Each a In Range([B4], [B65536].End(xlUp))
   
7.    For Each ky In d.keys
   
8.       If InStr(a, ky) > 0 Then a.Offset(, 2) = d(ky): Exit For
   
9.    Next
   
10. Next
    
11. End Sub

複製代碼

cdcc

回復 4# Hsieh


首先謝謝幫忙
   
但可否解釋"CreateObject("Scripting.Dictionary"這句的功能是什麼用途?

keys的功能是什麼用途?

而且那一句語法是寫 陣列{}??



謝謝.

Hsieh

Sub ex()
Set d = CreateObject("Scripting.Dictionary")  '建立一個字典變數
For Each a In Range([F5], [F65536].End(xlUp))
   d(a & "") = a.Offset(, 1).Value  '把F欄資料當作索引，G欄資料做對應直
Next
For Each a In Range([B4], [B65536].End(xlUp))  '以B欄資料做迴圈
   For Each ky In d.keys   '字典物件的每個索引值做迴圈
      If InStr(a, ky) > 0 Then a.Offset(, 2) = d(ky): Exit For  '如果索引值有被B欄資料包含時，將D欄填入索引的對應值
   Next
Next
End Sub

cdcc

Sub ex()
Set d = CreateObject("Scripting.Dictionary")  '建立一個字典變數
For Each a In Range([F5], ...
Hsieh 發表於 2011-5-12 23:13

    謝謝耐心教導.

dechiuan999

版主大大你好：

   小弟有一點不了解的地方，
請版主大大明示。

d(a & "") 為何可以取代 d(a.value)呢？

感恩大大！

GBKEE

回復 8# dechiuan999
d(a & "") 為何可以取代 d(a.value)呢？
a&"" 並非是要取代 a.value的用意 ,  a&""   -> 將a的內容轉換為字串
因為Scripting.Dictionary是物件 , 用於儲存資料關鍵字和項目(包含儲存格)

1. Sub Ex()
   
2. Dim d As Object, a
   
3. Set D = CreateObject("Scripting.Dictionary")
   
4. With ActiveSheet
   
5.     For Each a In .Range(.[F5], .[F10])
   
6.         D(a) = ""
   
7.     Next
   
8.     For Each a In D.keys
   
9.         MsgBox a.Address & ":  " & a.Value & ":  " & a.Row
   
10.         a.Select
    
11.     Next
    
12. End With
    
13. End Sub

複製代碼

dechiuan999

謝謝GBKEE版主大大。
EXCEL VBA真是博大精深。
也真是越學越有趣。

感恩大大！