excel - ActiveX 组件无法创建对象 --- Excel for Mac

Question

我正在尝试使用包含宏的 Excel 2011 32 位(适用于 Mac)电子表格。问题是这个宏在 PC 上运行良好，但在 Mac 上不行。我尝试导入 Tim Hall 的 Dictionary.cls，但还是不行。 KeyValuePair.cls 也是如此。

Error: Run-time error ’429’ ActiveX component can’t create object

我不是程序员，所以问题可能出在我身上，不知道要改变什么才能让事情正常进行。对于那些知道自己在做什么的人来说，这可能非常容易。谁能花几分钟查看文件并告诉我需要更改哪些部分才能使其运行？ [我认为它确实有效......]

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 上也会失败。通常使用早期绑定(bind)的构造是:

Set obj = New Dictionary

或使用后期绑定(bind):

Set obj = CreateObject("Scripting.Dictionary")

但是， Mac OS does not have the Scripting Runtime librar y，因此您将无法使用这些东西——字典、文件系统对象等。

您需要使用 Collection 或其他数据类型来代替 Dictionary 类型，或者您可以从 this other answer and implement a custom dictionary-like Class 借用.

I tried to import Tim Hall’s Dictionary.cls, but it still doesn’t work. Same thing for KeyValuePair.cls.

我怀疑您根本不知道您还需要使用条件编译方法来分配 Dictionary Mac OS 上的类和 Scripting.Dictionary Windows 操作系统上的类(class)。

在 Mac/Windows 上使用条件编译

删除这两行:

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

如上所述，即使在 Windows 中它们也会失败。同样，如果您想在 Win 和 Mac 环境中使用此代码，则不能使用 Scripting.Dictionary没有采取一些额外的预防措施来避免错误。

您需要使用 compiler directives 来实现条件编译。识别操作系统。对于以前做过的人来说，这并不太复杂，但大多数初学者甚至都不知道他们可以使用它，更不用说如何使用它了。

在伪代码中，基本上你正在这样做:

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来自 the other answer which implements the Dictionary replica 的代码进入纯文本文件，并将两个模块都导入项目的 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的方法。

注意:最好对这些对象分配进行分组，而不是在整个过程中随意使用它们，尤其是当您使用条件编译时，因为它更易于人类阅读并且更易于维护。