Arrays vba powerpoint从excel范围填充数组

我正在尝试使用MS Excel范围中的数据设置数组。 我的VBA宏用另一个数组中的文本替换数组中的文本。 它可以很好地处理数组，但现在我尝试用Excel文件中的数据填充这些数组。我正在使用range，我已经尝试了数千种方法，但都没有成功。我不是VBA编码员，所以可能我缺少一些基本概念|

这是密码。提前感谢您的帮助

Sub ReplacePT2ES()

    Dim oSld As Slide
    Dim oShp As Shape
    Dim oTxtRng As TextRange
    Dim oTmpRng As TextRange
    Dim strWhatReplace As String, strReplaceText As String
    Dim x As Long


    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim rng As range


    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("D:\DOCS\DiccionarioPT2ES.xlsx")
    xlBook.Application.Visible = False
    xlBook.Application.WindowState = xlMinimized


    Dim findList As Variant
    Dim replaceList As Variant

    Set findList = range("A1:A3").Value

    Set replaceList = range("B1:B3").Value
    '-- works fine with array
    'findList = Array("falha", "lei", "projeto", "falhas", "leis", "projetos", "falham", "os", "as", "gestor")
    'replaceList = Array("falla", "ley", "proyecto", "fallas", "leyes", "proyectos", "fallan", "los", "las", "gerente")

    'MsgBox "Iniciando!"

    For x = findList.Count To replaceList.Count
        ' go during each slides
        For Each oSld In ActivePresentation.Slides
             ' go during each shapes and textRanges
            For Each oShp In oSld.Shapes
                 ' replace in TextFrame
                'If oShp.HasTextFrame And UBound(findList) And UBound(replaceList) > 0 Then
                 If oShp.HasTextFrame Then

                    Set oTxtRng = oShp.TextFrame.TextRange
                    Set oTmpRng = oTxtRng.Replace(FindWhat:=findList(x), Replacewhat:=replaceList(x), WholeWords:=True)

                    Do While Not oTmpRng Is Nothing

                        Set oTxtRng = oTxtRng.Characters(oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)
                        Set oTmpRng = oTxtRng.Replace(FindWhat:=findList(x), Replacewhat:=replaceList(x), WholeWords:=True)
                    Loop
                 End If
            Next oShp
        Next oSld
    Next x

 xlBook.Close SaveChanges:=False
 Set xlApp = Nothing
 Set xlBook = Nothing
 'MsgBox "Listo!"


End Sub

---

最后，我找到了一个解决方案：停止使用数组并切换到字典。 在这里，代码起作用了：

Set findList = range("A1:A10")
Dim MyDictionary As Object
Set MyDictionary = CreateObject("Scripting.Dictionary")

With MyDictionary
    For Each RefElem In findList
        If Not .Exists(RefElem) And Not IsEmpty(RefElem) Then
            .Add RefElem.Value, RefElem.Offset(0, 1).Value
        End If
    Next RefElem
End With

---

历史的寓意：为作业使用正确的数据类型；）

您可以通过以下方式显著加快代码速度：

通过变量数组而不是范围循环

将IF测试分为两部分（VBA不会短路，因此将对

和
的两部分进行计算，即使第一部分为False）

代码

---

如果打开“局部变量”窗口并用F8单步执行宏，当到达fa x=。。。检查findlist和replacelist。它们是否像您期望的那样保存excel工作表中的值？将完整路径添加到范围中，指定工作簿和工作表，如

wb.ws.range（“A1:A3”）

，其中

wb

和

ws

是您设置所需工作簿和工作表对象的变量名。在您的代码中，您已经将

xlBook

设置为想要的工作簿，因此您缺少两条语句：工作表对象变量的声明（

dim ws as Worksheet

）和变量初始化（

set ws=xlBook.Worksheets（“putYourActualSheetName”）

）谢谢Rodger，该列表实际上是的，它显示excel的内容。我认为问题在于变量的种类。当它是数组时，它工作正常，当我尝试从范围数据类型中分配值时，就是它不工作的时候。这就是为什么到目前为止我的问题是：如何将数据范围值放入数组中。

Sub Recut()
Dim X
Dim MyDictionary As Object
Dim lngRow As Long
Set MyDictionary = CreateObject("Scripting.Dictionary")

X = Range("A1:B10").Value2
With MyDictionary
For lngRow = 1 To UBound(X)
    If Len(X(lngRow, 1)) > 0 Then
        If Not .Exists(X(lngRow, 1)) Then .Add X(lngRow, 1), X(lngRow, 2)
    End If
Next
End With
End Sub