- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
花了不少時間, 總算對 Ditionary 有一點點了解,
d(a.Value) = "" 與
If Not exists(a.Value) Then d.Add a.Value, "" 同義.
下列修改自 15# GBKEE版大的VBA(版大的執行結果完全正確),
請指教!!- '修改自 15# GBKEE版大的VBA
- Sub Test()
- Dim d As Object, d2 As Object, AR(1 To 3), ArC()
- Dim M As Variant, E As Variant
- Dim LstA As Integer, LstB As Integer, Cnt As Integer, Cnt2 As Integer
- Dim i As Integer, J As Integer
- Set d = CreateObject("SCRIPTING.DICTIONARY")
- Set d2 = CreateObject("SCRIPTING.DICTIONARY")
- Range("C:G").ClearContents '清除工作表4 C欄-->G欄
- Range("E:E").Interior.ColorIndex = xlNone
- LstB = [B65536].End(xlUp).Row
- Cnt = 1
- Cnt2 = 1
- ArC = Array(35, 36, 37, 38)
-
- '以下計算 工作表1-> 工作表3 出現機率為80%的字母*****
- For i = 1 To 3 '從 "工作表1" 到 "工作表3"
- Sheets(i).Range("C:E").ClearContents '清除每一頁的 C欄-->E欄
- With Sheets(i).[C1].Resize(Sheets(i).[B65536].End(xlUp).Row) '即[C1:Cxx]
- .Cells = "=COUNTIF(C2,RC[-1])/COUNTA(C1)"
- '[C1]公式 = COUNTIF(B:B,B1)/COUNTA(A:A), 即計算每個字母出現的機率
-
- AR(i) = Application.Transpose(.Offset(, -1).Resize(, 2).Value)
- '將 B欄,C欄 轉置為 AR(1 to 2, 1 to 21)
-
- '將英文字母出現百分比機率導入 AR(i)
- For Each E In .Cells '歷遍每一頁的 [C1:Cxx]
- d2.Item(E.Offset(, -1).Value) = E.Value
- '將字母(Key)及機率(Item)全部存入 字典d2 中(不論機率大小)
-
- If E >= 0.8 Then d(E.Offset(, -1).Value) = E.Value
- '將機率 >=80% 的字母及機率, 放到 字典d 中
- Next
-
- .Cells = .Value '公式轉為值
-
- If d.Count >= 1 Then
- .Cells(1).Range("B1").Resize(d.Count) = Application.Transpose(d.keys) '傾倒字母到每頁的 [D1:Dxx]
- .Cells(1).Range("C1").Resize(d.Count) = Application.Transpose(d.Items) '傾倒機率到每頁的 [E1:Exx]
- '★這裡若將 .Range("B1") 改為 .[B1]
- ' 則會出現 "物件不支援屬性或方法" 的錯誤!!
- End If
-
- If d2.Count >= 1 Then
- '固定式(工作表4的A欄及B欄的表格事先填好)
- '***工作表4上 B欄位中，每個英文字母出現在指定工作表的比率***
- M = Application.Match(Sheets(i).Name, [A:A])
- If IsNumeric(M) Then
- If i = 3 Then
- LstA = LstB
- Else
- LstA = Cells(M, 1).End(xlDown).Row - 1
- End If
- For J = M To LstA
- If d2.Exists(Cells(J, 2).Value) Then
- Cells(J, 3) = d2(Cells(J, 2).Value)
- End If
- Next
- Cnt = LstA + 1
- End If
-
- '機動式(E欄(工作表名稱)及F欄(字母)的表格由VBA填入)
- '***工作表4上 F欄位中，每個英文字母出現在指定工作表的比率***
- Cells(Cnt2, 5) = Sheets(i).Name '工作表名稱
- Cells(1).Range("E" & Cnt2).Resize(d2.Count).Interior.ColorIndex = ArC(i)
- Cells(1).Range("F" & Cnt2).Resize(d2.Count) = Application.Transpose(d2.keys) '傾倒字母
- Cells(1).Range("G" & Cnt2).Resize(d2.Count) = Application.Transpose(d2.Items) '傾倒機率
- Cnt2 = d2.Count + 1
- End If
- End With
- d.RemoveAll
- d2.RemoveAll
- Sheets(i).Range("C:C", "E:E").NumberFormatLocal = "0%" '數字格式化
- Next
- Range("C:C", "G:G").NumberFormatLocal = "0%" '數字格式化
- End Sub
|
|
發表於 2015-12-31 20:10
| 
