VB2008如何设置EXCEL单元格字母颜色
我在EXCEL用VBA写了段代码实现了单元格中,只要出现字母,就把字母颜色改为红色,但是同样的程序放到VB2008,效率却极端低下,同样的数据表,用VBA宏10秒钟就运行完,VB2008却用了将近5分钟,想请教朋友们应该怎样优化才好,谢谢!以下是VBA代码以及VB2008源代码:
VBA:
Sub MakeFine(minRow As Long, minCol As Long, maxRow As Long, maxCol As Long, maxLoop As Long)
Dim thisSheet As Worksheet
Dim i As Long, k As Long, j As Long, rowInt As Long, tmpl As Long, spaceNum As Integer, spaceLine As Integer
Dim colName As Long
Dim sCol As Integer, eCol As Integer
Dim isfirst As Boolean
Set thisSheet = ActiveSheet
Dim mainMinRow As Long
Dim mainMaxRow As Long
Dim mainMinCol As Long
Dim mainMaxCol As Long
Dim mainStep1 As Integer
Dim mainStep2 As Integer
Dim mainStep3 As Integer
mainStep1 = 0
mainStep2 = 0
mainStep3 = 0
mainMinRow = mainStep1 + 2
'用颜色标亮字母
For mainStep1 = mainMinRow To maxRow Step 1
For mainStep2 = 2 To maxCol Step 1
'DoEvents
For mainStep3 = 1 To Len(thisSheet.Cells(mainStep1, mainStep2))
If VBA.Mid(thisSheet.Cells(mainStep1, mainStep2), mainStep3, 1) Like "[a-zA-Z]" Then
thisSheet.Cells(mainStep1, mainStep2).Characters(mainStep3, 1).Font.ColorIndex = 3
End If
Next mainStep3
Next mainStep2
Next mainStep1
End Sub
VB2008:
Public Sub drawTableToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DrawTableToolStripMenuItem.Click
Dim openTabFile As New OpenFileDialog()
With openTabFile
.InitialDirectory = "e:\temp\"
.FileName = ""
.Filter = _
"Tab Documents (*.csv)|*.csv|" + _
"All Files (*.*)|*.*"
.FilterIndex = 1
.Title = "打开文件"
.Multiselect = True
.RestoreDirectory = False
End With
If openTabFile.ShowDialog = System.Windows.Forms.DialogResult.OK Then
Dim file As String
Dim myStream As Stream = Nothing
Dim rx As New Regex("[a-zA-Z]{1,}")
Dim xlApp As Application = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.ScreenUpdating = False
xlApp.EnableEvents = False
xlApp.DisplayAlerts = False
For Each file In openTabFile.FileNames
Try
Dim wb As Workbook = xlApp.Workbooks.Open(file)
Dim sht1 As Worksheet = wb.Sheets(1)
' Dim isSpaceCell As Boolean '不是空行
' Dim delRow As String
Dim maxLoop As Long
Dim maxColumn As Long
Dim maxRow As Long, maxCol As Long, minRow As Long, minCol As Long
Dim i As Long, j As Long, k As Long
'整理格式
'取得表格的最大行数
maxLoop = sht1.UsedRange.Rows.Count
maxColumn = sht1.UsedRange.Columns.Count
maxRow = 0
maxCol = 0
minRow = 0
minCol = 0
For i = 1 To maxLoop
If (sht1.Cells(i, 1).value = "$$$$" Or sht1.Cells(i, 1).value = "####") Then
If (minRow = 0 And minCol = 0 And maxRow = 0) Then
minRow = i + 1
minCol = 1
ElseIf (minRow <> 0 And maxRow = 0) Then
maxRow = i - 1
ElseIf (maxRow <> 0 And minRow <> 0) Then
minRow = maxRow + 2
maxRow = i - 1
End If
maxCol = maxColumn
'整理
If (minRow <> 0 And maxRow <> 0) Then
maxCol = 0
For j = minRow To maxRow
For k = 1 To maxColumn
If (CStr(sht1.Cells(j, k).value) <> "" And k >= maxCol) Then
maxCol = k
End If
Next k
Next j
End If
If (minRow <> 0 And maxRow <> 0 And maxCol <> 0) Then
'---------------------------------------------------------------------------------
Dim mainMinRow As Long
'Dim mainMaxRow As Long
'Dim mainMinCol As Long
'Dim mainMaxCol As Long
Dim mainStep1 As Integer
Dim mainStep2 As Integer
Dim mainStep3 As Integer
mainStep1 = 0
mainStep2 = 0
mainStep3 = 0
For mainStep1 = minRow To maxRow Step 1
If InStr(1, CStr(sht1.Cells(mainStep1, 1).value), "Base=", vbTextCompare) <> 0 Or InStr(1, CStr(sht1.Cells(mainStep1, 1).value), "基数=", vbTextCompare) <> 0 Or InStr(1, CStr(sht1.Cells(mainStep1, 1).value), "Base:", vbTextCompare) <> 0 Then
mainMinRow = mainStep1 + 2
Exit For
End If
Next mainStep1
'用颜色标亮字母
For mainStep1 = mainMinRow To maxRow Step 1
For mainStep2 = 2 To maxCol Step 1
'If CStr(sht1.Cells(mainStep1, mainStep2).value) <> "" Then
'If rx.IsMatch(sht1.Cells(mainStep1, mainStep2).value) Then
'For mainStep3 = 1 To Strings.Len(sht1.Cells(mainStep1, mainStep2).value)
' If Strings.Mid(sht1.Cells(mainStep1, mainStep2).value, mainStep3, 1) Like "[a-zA-Z]" Then
' sht1.Cells(mainStep1, mainStep2).Characters(mainStep3, 1).Font.ColorIndex = 3
' End If
'Next mainStep3
'End If
'End If
For mainStep3 = 1 To Strings.Len(sht1.Cells(mainStep1, mainStep2).value)
If Strings.Mid(sht1.Cells(mainStep1, mainStep2).value, mainStep3, 1) Like "[a-zA-Z]" Then
sht1.Cells(mainStep1, mainStep2).Characters(mainStep3, 1).Font.ColorIndex = 3
End If
Next mainStep3
Next mainStep2
Next mainStep1
End If
End If
Next i
wb.Activate()
sht1.Columns(1).ColumnWidth = 45
sht1.Cells(1, 1).Activate()
'sht1.SaveAs(Strings.Left(file, Len(file) - 4) & ".xls")
xlApp.ActiveWindow.Zoom = 85
wb.SaveAs(Filename:=Strings.Left(file, Len(file) - 4) & ".xls", _
FileFormat:=XlFileFormat.xlExcel8, _
Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False, _
AccessMode:=XlSaveAsAccessMode.xlNoChange)
sht1 = Nothing
wb.Close()
wb = Nothing
Catch ex As Exception
MessageBox.Show(ex.Message, My.Application.Info.Title, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
Next file
'清理
xlApp.Quit()
xlApp = Nothing
End If
End Sub
End Class --------------------编程问答-------------------- 想了蛮久,用过正则表达式,觉得还是很慢,请朋友们有时间帮忙看看,到底是哪部分导致效率低下,为什么同样的结构在VBA宏就没问题,放到VB.net操作excel就效率低了很多?有什么法子可以改进,谢谢!!
补充:.NET技术 , VB.NET