VB高手进，Msflexgrid空间，如何在单元格数据满足一定条件，自动改变单元格颜色？

我用Msflexgrid控件从EXCEL导入了数据，然后实时调整若干列的数据大小，问题是要使某一个单元格数据变化后颜色也要相应的变化。比如：大于1小于2 单元格颜色变黄，大于2颜色变红，请问怎么实现。我用的是一个循环，一个一个单元格与1 和2 进行大小比较，但是速度很慢，每次都要一个一个单元格进行比对，很卡，请问有没有快捷一点的方法，要设计到深层编程吗，比如Windows编程啥的？请高手指点。

这是从EXCEL里导入数据，我已经实现了，关键是怎么判断msflexgrid单元格数据大小然后使单元格变色。

Private Sub ImportExcel()

On Error Resume Next

Dim strPash As String

Dim XLS As Object

Dim WRK As Object

Dim SHT As Object

dsCmDlg.InitDir = App.Path

With dsCmDlg
.DefaultExt = "xls"
.ExtendedMode = 1
.Flags = fdlgOFN_EXPLORER Or fdlgOFN_ALLOWMULTISELECT Or fdlgOFN_SHOWHELP Or fdlgOFN_HIDEREADONLY
.Filter = "Excel(*.xls)|*.xls"
.HelpCommand = fdlgHELP_CONTEXT
.HelpContext = 31
.StartUpPosition = 3
.DialogLeft = 40
.DialogTop = 70
.ShowOpen
End With

strPash = dsCmDlg.fileName

If dsCmDlg.DialogCanceled Then Exit Sub
If strPash <> "" Then
txtConsumeFilePath.Text = strPash
cmbWorkSheet.Clear
'建立Excel新实例
Set XLS = CreateObject("Excel.Application")

'打开XLS文件. UpdateLink = False 和 ReadOnly = True.
Set WRK = XLS.Workbooks.Open(txtConsumeFilePath.Text, False, True)

'读取xls文件中的工作表
For Each SHT In WRK.Worksheets

'加载到列表框
cmbWorkSheet.AddItem SHT.Name
Next

cmbWorkSheet.ListIndex = 0
Call FillCoolGrid '加载第一张工作表

'关闭并不保存
WRK.Close False
'退出MS Excel
XLS.Quit

'释放变量
Set XLS = Nothing
Set WRK = Nothing
Set SHT = Nothing
Else
txtConsumeFilePath.Text = ""

End If

End Sub

Private Sub FillCoolGrid()

On Error GoTo errHandle

Dim XLS As New Excel.Application

Dim WRK As Excel.Workbook

Dim SHT As Excel.Worksheet

Dim RNG As Excel.Range

Dim r As Long

Dim c As Long

Dim i As Integer

Dim ArrayCells() As Variant

If cmbWorkSheet.ListIndex <> -1 Then
'建立Excel新实例
Set XLS = CreateObject("Excel.Application")
'打开 XLS 文件
Set WRK = XLS.Workbooks.Open(txtConsumeFilePath.Text, False, True)
'把当前选择的工作表赋值给SHT
Set SHT = WRK.Worksheets(cmbWorkSheet.List(cmbWorkSheet.ListIndex))

'得到当前工作表的使用范围
Set RNG = SHT.UsedRange

'重新分配数组
ReDim ArrayCells(1 To RNG.Rows.Count, 1 To RNG.Columns.Count)

'在使用范围内使用新的数组传值
ArrayCells = RNG.value

'关闭工作表
WRK.Close False
'退出 Excel
XLS.Quit

'变量释放
Set XLS = Nothing
Set WRK = Nothing
Set SHT = Nothing
Set RNG = Nothing

'网格数据显示设置
CoolGrid.Redraw = False
CoolGrid.FixedCols = 0
CoolGrid.FixedRows = 0
CoolGrid.Rows = UBound(ArrayCells, 1)
CoolGrid.Cols = UBound(ArrayCells, 2)

For r = 0 To UBound(ArrayCells, 1) - 1
For c = 0 To UBound(ArrayCells, 2) - 1
CoolGrid.TextMatrix(r, c) = CStr(ArrayCells(r + 1, c + 1))

DoEvents
Next
Next

CoolGrid.Redraw = True

AdjustColWidth frmEmployeeImport, CoolGrid '调整Grid各列列宽为最合适的宽度
Else
cmbWorkSheet.SetFocus
End If

Exit Sub

errHandle:
Call PrintErrInfo(err.Number, err.Description)

Exit Sub

End Sub

'//自动调整Grid各列列宽为最合适的宽度
Public Sub AdjustColWidth(frmCur As Form, _
gridCur As Object, _
Optional bNullRow As Boolean = True, _
Optional dblIncWidth As Double = 0)

'--------------------------------------------------------------------
'功能:
' 自动调整Grid各列列宽为最合适的宽度
'参数:
' [frmCur].........................................当前工作窗体
' [gridCur]........................................当前要调整的Grid
'--------------------------------------------------------------------
Dim i, j As Integer

Dim dblWidth As Double

With gridCur

For i = 0 To .Cols - 1
dblWidth = 0

If .ColWidth(i) <> 0 Then

For j = 0 To .Rows - 1

If frmCur.TextWidth(.TextMatrix(j, i)) > dblWidth Then
dblWidth = frmCur.TextWidth(.TextMatrix(j, i))
End If

Next

.ColWidth(i) = dblWidth + dblIncWidth + 100
End If

Next

End With

End Sub

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息