VB操作Excel

Private Sub Excel_Exchange()

'#先拷贝Excel
Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象
file = txtDirectory.Text
Set xlbook = xlapp.Workbooks.Open(file) '打开已经存在的EXCEL工件簿文件
xlapp.Visible = False '设置EXCEL对象可见（或不可见）
Set xlsheet = xlbook.Worksheets(1) '设置活动工作表
 xlsheet.Activate ''設定工作表為焦點
'xlSheet.Cells(Row, col) = 值 '给单元格（row,col）赋值
'xlSheet.PrintOut '打印工作表


 On Error GoTo ErrHandler
file = Replace(file, ".xls", "_new.xls")
 xlsheet.SaveAs file  'App.Path & "\test.xls"           '按指定文件名存盘
'statusTxt.Caption = "转换完成.新文件为:" & file
xlapp.Quit '结束EXCEL对象'xlapp.Workbooks.Close
 Set xlapp = Nothing '释放xlApp对象
 'xlappTarget.Quit '结束EXCEL对象'xlapp.Workbooks.Close
 'Set xlappTarget = Nothing '释放xlApp对象
 '#拷贝Excel完成,在新的Excel中做处理#
 '#打开拷贝的文件#
 Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlbook = xlapp.Workbooks.Open(file) '打开已经存在的EXCEL工件簿文件
xlapp.Visible = False '设置EXCEL对象可见（或不可见）
Set xlsheet = xlbook.Worksheets(1) '设置活动工作表
 xlsheet.Activate ''設定工作表為焦點
 
  Dim DataRange As Variant
  Dim Irow As Long
  Dim Icol As Integer
  Dim MaxCols As Long
   Dim status As String
   Dim errStatus As String
   
  Dim tim As Date
  Dim hh As Date
  
  
  DataRange = Range("A1").CurrentRegion.Value '不使用Set
  MaxRows = Range("A1").CurrentRegion.Rows.count
  'MaxCols = Range("A1").CurrentRegion.Columns.Count
  Dim count As Integer
  
  For Irow = 2 To MaxRows
   tim = DataRange(Irow, 4)
  ' Debug.Print tim
   ' status = DataRange(Irow, 6)
    errStatus = DataRange(Irow, 7)
   ' Debug.Print errStatus
     hh = Format(tim, "HH:mm:ss")
     
       If hh > "19:00" And hh < "23:59:59" Then
                If InStr(errStatus, "无效记录") > 0 Or InStr("无效记录", errStatus) Then
                'status = "加班签到"
                ''errStatus = "自由加班"
                 t = Format(tim, "MM\/dd\/yyyy HH:mm")
                 DataRange(Irow, 4) = t
                DataRange(Irow, 6) = "加班签到"
                 DataRange(Irow, 7) = "自由加班"
                ' Debug.Print "----19:00~23:59"
                 count = count + 1
                End If
             
        End If
        
       If hh > "00:00" And hh < "06:30" Then
        If InStr(errStatus, "无效记录") > 0 Or InStr("无效记录", errStatus) Then
         'status = "加班签退"
         ' errStatus = "自由加班"
                t = Format(tim, "MM\/dd\/yyyy HH:mm")
                 DataRange(Irow, 4) = t
           DataRange(Irow, 6) = "加班签退"
                 DataRange(Irow, 7) = "自由加班"
               ' Debug.Print "--------00~0630"
                 count = count + 1
                 End If
        End If
    
  Next Irow
   Range("A1").CurrentRegion = DataRange '将结果写回到区域中
  
  
  
 
statusTxt.Caption = "转换完成,修改" & count & "条记录。" & vbCrLf & "新文件为:" & file
xlapp.DisplayAlerts = False '不提示保存
xlapp.Save
xlapp.Quit '结束EXCEL对象'xlapp.Workbooks.Close
 Set xlapp = Nothing '释放xlApp对象
ErrHandler:
Debug.Print "修改记录:" & count
 Debug.Print "退出," & "修改记录:" & count & " " & Now()
            '用户按“取消”按钮。
  Exit Sub
End Sub


 

 

Private Sub exchangeButton_Click()
If StrComp(txtDirectory.Text, "") = 0 Then
MsgBox "请选择要转换的Excel文件"
Else
exchangeButton.Enabled = False
statusTxt.Visible = True

statusTxt.Caption = "转换中,请稍候..."
Excel_Exchange
'statusTxt.Caption = "转换完成."
exchangeButton.Enabled = True
End If



End Sub
 

Private Sub openButton_Click()
'CancelError 为 True。
            On Error GoTo ErrHandler
            '设置过滤器。
            CommonDialog1.Filter = "All Files (*.*)|*.*|Excel (*.xls)|*.xls"
            '指定缺省过滤器。
            CommonDialog1.FilterIndex = 2
            '显示“打开”对话框。
            CommonDialog1.ShowOpen
           txtDirectory.Text = CommonDialog1.FileName
            '调用打开文件的过程。
           ' OpenFile (CommonDialog1.FileName)
ErrHandler:
            '用户按“取消”按钮。
            Exit Sub

End Sub
 

 注意客户端机器要注册:COMDLG32.OCX

拷贝 COMDLG32.OCX 到 c:\Windows\system32
运行命令注册
Regsvr32 COMDLG32.OCX

 

直接使用for循环操作，非常非常慢。现在这种处理方式，几秒钟可以处理完，用 For需要几分钟的时间