使用vbscript创建稀疏矩阵

Question

假设我有一个数组= {A，B，Y，X}。我现在具有可以具有列和Rows.Say的动态数如下面的例子的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