vba powerpoint从excel范围填充数组答案

【问题标题】：vba powerpoint populating an array from excel rangevba powerpoint从excel范围填充数组
【发布时间】：2016-06-28 04:56:19
【问题描述】：

我正在尝试使用 MS Excel 范围内的数据设置一个数组。我的 VBA 宏将数组中的文本替换为另一个数组中的文本。它适用于数组，但现在我正在尝试用 Excel 文件中的数据填充这些数组。我正在使用范围，并且尝试了数千种使其工作的方法，但均未成功。我不是 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

【问题讨论】：

如果您打开本地窗口并使用 F8 单步执行宏，当您到达 fa x = ... 行时，检查 findlist 和 replacelist。它们是否像您期望的那样保存您 Excel 表中的值？
添加范围的完整路径，指定工作簿广告工作表，如 wb.ws.Range("A1:A3") ，其中 wb 和 ws 是您设置所需工作簿和工作表对象的变量名称。在您的代码中，您已经将 xlBook 设置为所需的工作簿，因此您缺少两个语句：工作表对象变量的声明 (dim ws as Worksheet) 和变量初始化 (set ws = xlBook.Worksheets("putYourActualSheetName"))
感谢罗杰，列表实际上是的，它显示了 excel 的内容。我认为，问题在于变量的种类。当它的数组工作正常时，当我尝试从 Range 数据类型中评估值时，它就不起作用了。这就是为什么到目前为止我的问题是：如何将数据范围值放入数组中。

标签： arrays excel vba range powerpoint

【解决方案1】：

最后我找到了解决方案：停止使用 Array 并切换到 Dictionary。这里的代码工作：

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

历史的道德：为工作使用正确的数据类型；）

【讨论】：

【解决方案2】：

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

循环遍历变量数组而不是范围
将 IF 测试分成两部分（VBA 不会短路，因此即使第一部分为 False，VBA 也会评估 AND 的两部分）。

代码

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

【讨论】：