在Mac / Windows上使用条件编译

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”)

RandomiseData文件：

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 does not have the Scripting Runtime librar y，所以这些东西都不可用 - Dictionary，FileSystemObject等。

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

我试图导入Tim Hall的Dictionary.cls，但它仍然不起作用。 KeyValuePair.cls也是如此。

我怀疑你根本不知道你还需要使用条件编译方法在Mac OS上分配Dictionary类，并且Windows操作系统上的Scripting.Dictionary类。

在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，无论你把它放在哪里都无关紧要。< / p>

这应该适用于两个操作系统，因为Dictionary.cls模仿了Scripting.Dictionary的方法。

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

Answer 2

我看到你说＆＃34;我试图导入Tim Hall的Dictionary.cls，但它仍然不起作用。 KeyValuePair.cls也是一样。＆＃34;

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。我认为让一个班级在你的控制之下比两个班级可能以某种微妙的方式偏离更好。

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

2 个答案:

在Mac / Windows上使用条件编译

在您的代码中，执行类似这样的操作