vbscript Excel匹配函数

vbscript Excel匹配函数,excel,vbscript,Excel,Vbscript,我有一个工作表,大约有10万行,大概有24列。目前我正在给一个特定的列上色,比如ABC,当值>x时,将interior.colorindex设置为y。此时,我必须对该列进行降序排序,然后使用FOR-EACH语句,循环遍历每个行单元格,直到值

我有一个工作表,大约有10万行,大概有24列。目前我正在给一个特定的列上色,比如ABC,当值>x时,将interior.colorindex设置为y。此时,我必须对该列进行降序排序,然后使用FOR-EACH语句,循环遍历每个行单元格,直到值 我想做的是,通过使用Excel匹配函数,找到最后一行编号,然后在一个块中而不是单个单元格中为单元格着色,从而使这一点更加有效,但无法使我笨拙的编码正常工作。我所读到的一切似乎都表明vbscript中支持匹配函数,但我需要某种灵魂的帮助来解决这个问题。我已将我的代码精简到相关部分,并将感谢您提供的帮助。请原谅我的无知,我对编码这件事很陌生,这是我第一次请求帮助

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命令来建立范围行号,然后按范围块对单元格着色,而不是单独着色,这显然需要时间。嗯。。只是一个想法,我想知道是否因为我关闭了自动计算,这是否是造成问题的原因?我得检查一下我什么时候能到办公室。