【发布时间】：2019-09-13 01:08:42
【问题描述】：
我有一个大约 100k 行 x 大约 2 打列的工作表。目前我正在为一个特定的列着色，比如“ABC”，当值大于 x 时，将 internal.colorindex 设置为 y。目前我必须对这一列进行降序排序，然后使用 FOR EACH 语句，循环遍历每个行单元格，直到值
我想要做的是通过使用 Excel MATCH 函数来提高效率，找到最后一个行号，然后为一个块中的单元格而不是单个单元格着色，但无法让我笨拙的编码正常工作。我读过的所有内容似乎都表明 vbscript 支持 MATCH 函数，但我需要一些善良的灵魂来解决这个问题。我已将我的代码精简到相关部分，并将不胜感激并提供帮助。请原谅我的无知，我对这个编码很陌生，这是我第一次请求帮助。
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)
【问题讨论】：
-
您在此处尝试复制的 Excel 内置功能称为“条件格式”。
-
想到了，但感谢您的建议。这里的问题是我必须通过 Excel 外部的命令行来执行此操作，并且要求我无法分发在文件中启用了条件格式的结果文件。我之前一直在寻找一种在模板文件中使用条件格式的方法，但无法弄清楚如何删除 CF 规则但保留格式化的结果单元格。尝试过特殊的复制和粘贴，但也无法正常工作，似乎总是带来规则，不能只获得值和颜色。
-
我要避免的是循环遍历整个 100K 行，我目前必须直到达到小于值，此时我记下该行并使用 rowcount 为最后一个范围着色，但是大于 15 并且介于 14 和 9 之间，如果不使用 Match 之类的东西，我就无法建立范围地址。
-
我希望我能做的是发出 3 或 4 个匹配命令来建立范围行号，然后按范围块为单元格着色，而不是单独着色，这显然需要时间。
-
嗯 .. 只是一个想法，我想知道是否因为我关闭了自动计算，这是否会导致问题？我得看看我什么时候能到办公室。