当前位置:编程学习 > C#/ASP.NET >>

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
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,