使用vbscript创建稀疏矩阵 [英] Sparse matrix creation using vbscript
本文介绍了使用vbscript创建稀疏矩阵的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
输入:
ColA ColC ColC ....
TPY ....
CYD ....
BAM ....
ZRX ....
OutPut:
ColA ColB ColC ... 。
- - Y ....
- Y - ....
BA - ....
- - X ....
其中所有列只有Array值,如果找到其他任何值,则需要替换它们通过 -
除了比较慢的循环技术,使用VBscript有更快的过程吗? / p>
谢谢,
解决方案
Sub Macro1()
Dim arr,i,rng As Range
arr = Array(X,Y,Z)
设置rng = ActiveSheet.Range(A1)。CurrentRegion
应用程序
.ScreenUpdating = False
.Calculation = xlCalculationManual
结束
对于i = LBound(arr)到UBound(arr)
rng.Replace什么:= arr(i),替换:= - ,LookAt:= xlWhole,_
SearchOrder:= xlByRows,MatchCase:= True,SearchFormat:= False,_
ReplaceFormat:= False
下一个i
应用程序
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
结束
End Sub
编辑:
Sub KeepValues()
Dim arr,arrVals,i,rng As Range,r,c
Dim keepval As Boolean
arr = Array(X,Y,Z)
设置rng = ActiveSheet.Range(A1)CurrentRegion
arrVals = rng.Value
对于r = 1到UBound(arrVals,1)
对于c = 1到UBound(arrVals,2)
keepval = False
对于i = LBound(arr)到UBound (arr)
如果arr(i)= arrVals(r,c)然后
keepval = True
退出
结束If
下一个i
如果不保留然后arrVals(r,c)=
下一个c
下一个r
rng.Value = arrVals
End Sub
Suppose I have an Array={A,B,Y,X}. Now I do have an Excel sheet which can have dynamic number of columns and Rows.Say as an example below :
Input:
ColA ColB ColC ....
T P Y ....
C Y D ....
B A M ....
Z R X ....
OutPut:
ColA ColB ColC ....
- - Y ....
- Y - ....
B A - ....
- - X ....
Where all the columns will have only the Array values,if any other values are found they are required to be replaced by "-"
Is there any faster process to do these using VBscript except comparatively slow looping technique?
Thanks,
解决方案
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
EDIT:
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创建稀疏矩阵的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文