excel - 使用 vbscript 创建稀疏矩阵

Question

假设我有一个 Array={A,B,Y,X}。现在我确实有一个 Excel 工作表，它可以有动态的列数和行数。比如下面的例子：

输入：

ColA   ColB   ColC  ....

 T      P      Y    ....
 C      Y      D    ....
 B      A      M    ....
 Z      R      X    ....

输出：

ColA   ColB   ColC  ....

 -      -      Y    ....
 -      Y      -    ....
 B      A      -    ....
 -      -      X    ....

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

除了相对较慢的循环技术之外，是否有任何更快的过程可以使用 VBscript 来完成这些工作？

谢谢，

Answer 1

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