Excel 使用vbscript创建稀疏矩阵

假设我有一个数组={A，B，Y，X}。现在我有了一个Excel工作表，它可以有动态的列数和行数。例如：

输入：

Sub KeepValues()

    Dim arr, arrVals, i, rng As Range, r, c
    Dim keepval As Boolean

    arr = Array("X", "Y", "Z")

    Set rng = ActiveSheet.Range("A1").CurrentRegion
    arrVals = rng.Value

    For r = 1 To UBound(arrVals, 1)
        For c = 1 To UBound(arrVals, 2)
            keepval = False
            For i = LBound(arr) To UBound(arr)
                If arr(i) = arrVals(r, c) Then
                    keepval = True
                    Exit For
                End If
            Next i
            If Not keepval Then arrVals(r, c) = ""
        Next c
    Next r

    rng.Value = arrVals

End Sub

输出：

Sub KeepValues()

    Dim arr, arrVals, i, rng As Range, r, c
    Dim keepval As Boolean

    arr = Array("X", "Y", "Z")

    Set rng = ActiveSheet.Range("A1").CurrentRegion
    arrVals = rng.Value

    For r = 1 To UBound(arrVals, 1)
        For c = 1 To UBound(arrVals, 2)
            keepval = False
            For i = LBound(arr) To UBound(arr)
                If arr(i) = arrVals(r, c) Then
                    keepval = True
                    Exit For
                End If
            Next i
            If Not keepval Then arrVals(r, c) = ""
        Next c
    Next r

    rng.Value = arrVals

End Sub

其中，所有列只有数组值，如果发现任何其他值，则需要将其替换为“-”

除了相对较慢的循环技术外，使用VBscript是否还有更快的过程

谢谢

Sub Macro1()

    Dim arr, i, rng As Range

    arr = Array("X", "Y", "Z")
    Set rng = ActiveSheet.Range("A1").CurrentRegion

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    For i = LBound(arr) To UBound(arr)
        rng.Replace What:=arr(i), Replacement:="-", LookAt:=xlWhole, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
    Next i

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

编辑：

Sub KeepValues()

    Dim arr, arrVals, i, rng As Range, r, c
    Dim keepval As Boolean

    arr = Array("X", "Y", "Z")

    Set rng = ActiveSheet.Range("A1").CurrentRegion
    arrVals = rng.Value

    For r = 1 To UBound(arrVals, 1)
        For c = 1 To UBound(arrVals, 2)
            keepval = False
            For i = LBound(arr) To UBound(arr)
                If arr(i) = arrVals(r, c) Then
                    keepval = True
                    Exit For
                End If
            Next i
            If Not keepval Then arrVals(r, c) = ""
        Next c
    Next r

    rng.Value = arrVals

End Sub

---

你写代码了吗？速度慢吗？我希望它会很快。是的，我使用了循环技术。这是我粘贴在这里的一个特殊快照。实际的工作表有3500行和250列，这使它更慢。因此我想知道有什么最快的过程。你能发布你使用的代码吗？@user1878162请在你的问题帖子中发布你当前的代码。这将使我们能够更好地帮助您。@user1878162，出于好奇：您使用VBscript而不是VBA有什么特别的原因吗？VBA与Excel电子表格内容紧密链接，在您想要的级别上与它交互可能更容易谢谢Tim的更新，但我正在寻找一个相同的VBscript代码。我认为您的宏将用“-”替换矩阵中的数组元素。我说得对吗？如果我是对的，那么我想告诉你，我想要你实现的相反的东西。除了数组元素之外，所有元素都需要用“-”替换。请帮助我使用一些VBscript。。我不熟悉VBA。嗨，蒂姆，你能在这里帮助我吗？你好，蒂姆，你能告诉我我应该如何更改你的代码，使其与当前的操作相反，请告诉我