ActiveX 組件無法創建對象 --- Excel for Mac

Question

我正在嘗試獲取包含宏的 Excel 2011 32 位（適用於 Mac）電子表格。 問題是這個宏在 PC 上工作正常，但在 Mac 上卻不行。 我嘗試導入 Tim Hall 的 Dictionary.cls，但它仍然不起作用。 KeyValuePair.cls 也一樣。

錯誤：運行時錯誤“429”ActiveX 組件無法創建對象

我不是程序員，所以問題可能出在我身上，不知道要改變什么才能讓事情正常進行。 對於那些知道自己在做什么的人來說，這可能非常容易。 任何人都可以花幾分鍾查看文件並告訴我需要更改哪些部分才能運行它嗎？ [我認為它確實有效……]

FWIW，我曾嘗試在兩個地方用“New.Dictionary”替換“Scripting.Dictionary”（見下文），但這並沒有成功。

Set dAttributes = CreateObject("New.Dictionary")

Set dValues = CreateObject("New.Dictionary”)

隨機數據文件：

Option Explicit
Sub GenerateResults()

Dim LO As ListObject
Dim LO2 As ListObject
Dim LR As ListRow
Dim ws As Worksheet
Dim cCount As Integer
Dim gCount As Integer
Dim dAttributes As Object
Dim dValues As Object
Dim dKey As Variant
Dim c As Range
Dim v As Variant
Dim i As Integer
Dim InsertCount As Integer

Set LO = ActiveSheet.ListObjects("Data")
If LO Is Nothing Then MsgBox "Please select the table and re-run": Exit Sub
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With
LO.AutoFilter.ShowAllData

Set ws = ActiveWorkbook.Sheets.Add
ws.Range("A1:C1").Value = Array("Candidate", "Attribute", "Value")
ws.ListObjects.Add xlSrcRange, Range("A1:C1"), , xlYes
Set LO2 = ws.Range("A1").ListObject

Set dAttributes = CreateObject(“New.Dictionary")
For Each c In LO.ListColumns("Attribute").DataBodyRange.Cells
If Not dAttributes.Exists(c.Value) Then dAttributes(c.Value) = c.Value
Next c

For Each dKey In dAttributes.Keys
LO.Range.AutoFilter Field:=LO.ListColumns("Attribute").Index,    Criteria1:=dKey
gCount = Evaluate("SUM(--(FREQUENCY(IF(" & LO.Name & "[Attribute]=""" & dKey & """,MATCH(" & LO.Name & "[Value]," & LO.Name & "[Value],0)),ROW(" & LO.Name & "[Value])-ROW(" & LO.Name & "[[#Headers],[Value]]))>0))")
cCount = Evaluate("SUM(--(FREQUENCY(IF(" & LO.Name & "[Attribute]=""" & dKey & """,MATCH(" & LO.Name & "[Candidate]," & LO.Name & "[Candidate],0)),ROW(" & LO.Name & "[Candidate])-ROW(" & LO.Name & "[[#Headers],[Candidate]]))>0))")
v = GenerateSplit(cCount, gCount)
Set dValues = CreateObject(“New.Dictionary")

For Each c In LO.ListColumns("Value").DataBodyRange.SpecialCells(xlCellTypeVisible)
    If Not dValues.Exists(c.Value) Then dValues(c.Value) = c.Value
Next c

InsertCount = 0
i = 1
For Each c In LO.ListColumns("Candidate").DataBodyRange.SpecialCells(xlCellTypeVisible)
TryAgain:
If i <= v(InsertCount, 2) Then
    Set LR = LO2.ListRows.Add
    LR.Range.Value = Array(c.Value, dKey, dValues.Items()(InsertCount))
    i = i + 1
Else
    i = 1
    InsertCount = InsertCount + 1
    GoTo TryAgain
End If
Next c

Next dKey
LO.AutoFilter.ShowAllData
LO.Range.Worksheet.Select

With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub

編輯代碼

Option Explicit
Sub GenerateResults()

Dim LO As ListObject
Dim LO2 As ListObject
Dim LR As ListRow
Dim ws As Worksheet
Dim cCount As Integer
Dim gCount As Integer
Dim dAttributes As Object
Dim dValues As Object
Dim dKey As Variant
Dim c As Range
Dim v As Variant
Dim i As Integer
Dim InsertCount As Integer

#If Mac Then
Set dAttributes = New Dictionary
Set dValues = New Dictionary
#Else
Set dAttributes = CreateObject("Scripting.Dictionary")
Set dValues = CreateObject("Scripting.Dictionary")
#End If

Set LO = ActiveSheet.ListObjects("Data")
If LO Is Nothing Then MsgBox "Please select the table and re-run": Exit Sub
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With
LO.AutoFilter.ShowAllData

Set ws = ActiveWorkbook.Sheets.Add
ws.Range("A1:C1").value = Array("Candidate", "Attribute", "Value")
ws.ListObjects.Add xlSrcRange, Range("A1:C1"), , xlYes
Set LO2 = ws.Range("A1").ListObject

' Set dAttributes = CreateObject("New Dictionary")
For Each c In LO.ListColumns("Attribute").DataBodyRange.Cells
If Not dAttributes.Exists(c.value) Then dAttributes(c.value) = c.value
Next c

For Each dKey In dAttributes.Keys
LO.Range.AutoFilter Field:=LO.ListColumns("Attribute").Index,    Criteria1:=dKey
gCount = Evaluate("SUM(--(FREQUENCY(IF(" & LO.Name & "[Attribute]=""" & dKey & """,MATCH(" & LO.Name & "[Value]," & LO.Name & "[Value],0)),ROW(" & LO.Name & "[Value])-ROW(" & LO.Name & "[[#Headers],[Value]]))>0))")
cCount = Evaluate("SUM(--(FREQUENCY(IF(" & LO.Name & "[Attribute]=""" & dKey & """,MATCH(" & LO.Name & "[Candidate]," & LO.Name & "[Candidate],0)),ROW(" & LO.Name & "[Candidate])-ROW(" & LO.Name & "[[#Headers],[Candidate]]))>0))")
v = GenerateSplit(cCount, gCount)
' Set dValues = CreateObject("Scripting.Dictionary")

For Each c In  LO.ListColumns("Value").DataBodyRange.SpecialCells(xlCellTypeVisible)
    If Not dValues.Exists(c.value) Then dValues(c.value) = c.value
Next c

InsertCount = 0
i = 1
For Each c In LO.ListColumns("Candidate").DataBodyRange.SpecialCells(xlCellTypeVisible)
TryAgain:
If i <= v(InsertCount, 2) Then
    Set LR = LO2.ListRows.Add
    LR.Range.value = Array(c.value, dKey, dValues.Items()(InsertCount))
    i = i + 1
Else
    i = 1
    InsertCount = InsertCount + 1
    GoTo TryAgain
End If
Next c

Next dKey
LO.AutoFilter.ShowAllData
LO.Range.Worksheet.Select

With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub

Answer 1

New.Dictionary不是有效的類名，在 PC 上也會失敗。 通常使用早期綁定的構造是：

Set obj = New Dictionary

或者使用后期綁定：

Set obj = CreateObject("Scripting.Dictionary")

然而， Mac OS 沒有 Scripting Runtime 庫，因此您無法使用這些東西——Dictionary 、FileSystemObject 等。

您需要使用 Collection 或其他數據類型來代替 Dictionary 類型，或者您可以借鑒其他答案並實現自定義字典類 Class 。

我嘗試導入 Tim Hall 的 Dictionary.cls，但它仍然不起作用。 KeyValuePair.cls 也一樣。

我懷疑您根本不知道您還需要使用條件編譯方法在 Mac 操作系統上分配Dictionary類，在 Windows 操作系統上分配Scripting.Dictionary類。

在 Mac/Windows 上使用條件編譯

刪除這兩行：

Set dAttributes = CreateObject("New.Dictionary")
Set dValues = CreateObject("New.Dictionary")

如上所述，即使在 Windows 中它們也會失敗。 同樣，如果您想在Win 和 Mac 環境中使用此代碼，則不能在不采取一些額外的預防措施來避免錯誤的情況下使用Scripting.Dictionary 。

您將需要使用 編譯器指令來識別操作系統來實現條件編譯。 對於以前做過的人來說，這並不過分復雜，但大多數初學者甚至都不知道他們可以使用它，更不用說如何使用它了。

在偽代碼中，基本上你是這樣做的：

If the operating system is Mac, then:
    Do this
ElseIf the operating system is Win, then:
    Do that instead
End If

在你的代碼中，做這樣的事情

假設您已將KeyValuePair.cls和Dictionary.cls代碼從實現字典副本的其他答案復制到純文本文件中，並將這兩個模塊導入到項目的 VBE 中。

#IF Mac Then
    Set dAttributes = New Dictionary
    Set dValues = New Dictionary
#Else
    Set dAttributes = CreateObject("Scripting.Dictionary")
    Set dValues = CreateObject("Scripting.Dictionary")
#End If

我會將此代碼放在該行的上方：

Set LO = ActiveSheet.ListObjects("Data")

實際上，只要在調用dAttributes或dValues之前將該代碼放置在任何位置，放置它的位置並不重要。

這應該適用於兩種操作系統，因為Dictionary.cls模仿Scripting.Dictionary的方法。

注意：最好將這些對象分配分組，而不是在整個過程中隨意地添加它們，尤其是當您使用條件編譯時，因為它更易於閱讀並且更容易繼續前進。

Answer 2

我看到你說“我試圖導入 Tim Hall 的 Dictionary.cls，但它仍然不起作用。KeyValuePair.cls 也是如此。”

Tim Halls 的 2016 Dictionary.cls 完全替代了 Scripting.Dictionary，並且不需要 KeyValuePair.cls，它是我在https://sysmod.wordpress.com/2011/11/24/dictionary-vba-class提供的輔助類-update/用於我的 2011 Dictionary.cls。 使用他的課程或我的一對課程，但不能同時使用。

有關條件編譯的建議對於編寫可在 Mac 或 PC 上運行的代碼很有幫助。 我建議如果您有自己的字典類，則根本不需要 Windows Scripting.Dictionary。 我認為讓一個班級在你的控制之下比兩個班級更好，因為他們可能會以某種微妙的方式偏離。