vbscript Excel匹配函数
我有一个工作表,大约有10万行,大概有24列。目前我正在给一个特定的列上色,比如ABC,当值>x时,将interior.colorindex设置为y。此时,我必须对该列进行降序排序,然后使用FOR-EACH语句,循环遍历每个行单元格,直到值vbscript Excel匹配函数,excel,vbscript,Excel,Vbscript,我有一个工作表,大约有10万行,大概有24列。目前我正在给一个特定的列上色,比如ABC,当值>x时,将interior.colorindex设置为y。此时,我必须对该列进行降序排序,然后使用FOR-EACH语句,循环遍历每个行单元格,直到值
Dim objXLApp, objXLWb, objXLWs, objWorksheet, WorksheetFunction
Dim InFile, OutFile
Dim ObjRange, ObjRange2, ObjRange3, rng, rng1, rng2, trng
Dim iRows, iCols, iR, iC, lRow, fRow, col, rw, tRow
Dim ColSearch, StartTime, EndTime, TotalTime
Dim cTeal, cPurple, cCyan, cVal, opVal
Dim Counttcolor, Countpcolor, Countccolor, clr
Dim vMsg
' input parameters
InFile = Wscript.Arguments.Item(0)
OutFile = Wscript.Arguments.Item(1) 'this output file CAN be the same as the input thereby overwriting if required.
Set objXLApp = CreateObject("Excel.Application")
'application function SWITCHES - set to TRUE to enable
objXLApp.Visible = True
objXLApp.EnableEvents = True
objXLApp.DisplayAlerts = True
objXLApp.ScreenUpdating = True
objXLApp.DisplayStatusBar = False
vMsg = 1 ' set to 1 to turn on timer prompts for each processing section
Set objXLWb = objXLApp.Workbooks.Open(InFile)
'Select the appropriate Sheet in the Workbook
Set objXLWs = objXLWb.Sheets(1)
objXLWb.Sheets(1).Activate
objXLWs.DisplayPageBreaks = False
'decleration must be AFTER opening the input file
objXLApp.Calculation = xlCalculationManual
objXLApp.CalculateBeforeSave = True
' Set range and count Row & Columns
Set objRange = objXLWs.UsedRange
iRows = objRange.Rows.Count
iCols = objRange.Columns.Count
'MsgBox iRows
'MsgBox iCols
StartTime = Timer()
ColSearch = "ABC" 'COLUMN AS
For iC = 1 To iCols
If InStr(objRange.Item(1, iC).Value2,ColSearch) Then
'sort the column descending to bring highest records to the top
Set objRange = objXLWs.UsedRange
Set objRange2 = objXLApp.Range(objRange.Item(2, iC).Address) 'ABC
objRange.Sort objRange2, xlDescending, , , , , , xlYes
cTeal = 15 'set the teal minimum value
'set the range for the match function to search for the min cTeal value
rng = objRange.Item(2, iC).Address &":"& objRange.Item(iRows, iC).Address
'search for the first row number containing the first value less than cTeal
tRow = objXLApp.match(cTeal, rng, -1)
MsgBox tRow 'this presently fails here with object required if commented fails at set trng with reference to tRow variable
'set the range for coloring the entire block of cells
Set trng = objRange.Item(2, iC).Address &":"& objRange.Item(tRow, iC).Address
objXLApp.Range(trng).Interior.ColorIndex = 42 'Teal
End If
Next
EndTime = Timer()
If vMsg = 1 Then MsgBox "ABC: " & FormatNumber(EndTime - StartTime, 2)
问题解决了,这是一个范围问题。需要将范围设置为单个列,即:a:a,而不是现有的单元格引用,但我现有的代码中有一些错误。无论如何,谢谢你 为了便于参考,以下是工作代码:
ColSearch = "ABC"
For iC = 1 To iCols
If InStr(objRange.Item(1, iC).Value2,ColSearch) then
'to get the column letter for setting the rng param for match function
col_letter = Split(objRange.Item(1, iC).Address, "$")(1)
cTeal = 14
cPurple = 5
'set the range address string
col_letter = col_letter & ":" & col_letter
'set the range to a single column letter/name for the match function
set rng = objXLApp.Range(col_letter)
tRow = objXLApp.Match(cTeal,rng,-1) 'find the last row for Teal value
pRow = objXLApp.Match(cPurple,rng,-1) 'find the row for Purple value
'Msgbox tRow
'Msgbox pRow
objXLApp.Range(objRange.Item(2, iC).Address & ":" & objRange.Item(tRow, iC).Address).Interior.ColorIndex = 42 'Teal
objXLApp.Range(objRange.Item(tRow+1, iC).Address & ":" & objRange.Item(pRow, iC).Address).Interior.ColorIndex = 34 'Cyan
objXLApp.Range(objRange.Item(pRow+1, iC).Address & ":" & objRange.Item(objRange.Item(2, iC).End(xlDown).Row, iC).Address).Interior.ColorIndex = 39 'Purple
End If
Next
您试图在此处复制的Excel内置功能称为条件格式。考虑过这一点,但感谢您的建议。这里的问题是,我必须通过Excel外部的命令行来执行此操作,并且要求我不能分发文件中启用条件格式的结果文件。我之前一直在寻找一种在模板文件中使用条件格式的方法,但不知道如何删除CF规则,而是保留格式化的结果单元格。我尝试过复制和粘贴special,但也无法使其发挥作用,似乎总是带来规则,无法仅获得值和颜色。我试图避免的是在整个100K行中循环,我目前必须直到达到小于值,在该值处我记录行并使用rowcount为最后一个范围着色,但是大于15,介于14和9之间,如果不使用Match之类的工具,我就无法建立范围地址。我希望我能做的是发出3或4个Match命令来建立范围行号,然后按范围块对单元格着色,而不是单独着色,这显然需要时间。嗯。。只是一个想法,我想知道是否因为我关闭了自动计算,这是否是造成问题的原因?我得检查一下我什么时候能到办公室。