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需要几分钟的时间