使用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