宏命令语句(文件打开级内容处理)

Function OpenExcelFile(sPath As String, ByVal sFileName As String, bDisplay As Boolean, sPwd As String) As Integer许长安 时间: 2016-2-4打开Excel文件参数说明：sPath:文件绝对路径；sFileName:Excel文件名；bDisplay:True显示错误信息；sPwd:文件打开密码返回值：-1:同名文件已经打开；-2:文件不存在或密码错误；0:成功打开；1:文件已经被打开Dim bOpen As BooleanDim sFullName As StringOn Error Resume NextIf InStr(LCase(sFileName), .xls) = 0 Then sFileName = sFileName & .xlssFullName = Workbooks(sFileName).FullName检查是否已经打开同名的Excel文件如果有sFullName不为空On Error GoTo 0bOpen = FalseIf sFullName ThenIf LCase(sFullName) = LCase(sPath & & sFileName) ThenbOpen = True判断已经打开的同名文件是否本次需要打开的文件OpenExcelFile = 1文件已经被打开MsgBox 请首先关闭“ & sFileName & ”文件！ & Chr(13) & 不能同时打开同名文件，这是Excel的规定！, vbOKOnly + vbExclamation, 文件的打开错误ElseIf bDisplay ThenMsgBox 请首先关闭“ & sFileName & ”文件！ & Chr(13) & 不能同时打开同名文件，这是Excel的规定！, vbOKOnly + vbExclamation, 文件的打开错误End IfbOpen = TrueOpenExcelFile = -1不能同时打开同名文件，这是Excel的规定End IfEnd IfIf Not bOpen ThenOn Error GoTo errOpenWorkbooks.Open FileName:=sPath & & sFileName, Password:=sPwdOn Error GoTo 0OpenExcelFile = 0成功打开文件End IfExit FunctionerrOpen:If bDisplay Then MsgBox Err.Description, vbOKOnly + vbExclamation, 文件的打开错误OpenExcelFile = -2文件不存在或密码错误On Error GoTo 0End FunctionSub fileproce() Macro5 Macro 宏由 许长安 录制，时间: 2016-2-28MergeArea.Rows.CountMergeArea.Columns.CountRange(B7:B28).Selectrow = ActiveCell.row()col = ActiveCell.Column() Dim i, h As Long Dim row, col, rangrows, countrows As Long i = 0 countrows = ActiveCell.row() MsgBox 当前文件总并行数： & countrows & ！rangrows = Cells(row, col).MergeArea.Rows.Count 从B列第7行开始Range(B7:B & rangrows).SelectMsgBox B7当前合并行数： & rangrows & ！ row = 7 定义起始行数 col = 2 定义从B列开始Do While row ActiveSheet.UsedRange.Rows.Count() 设定总行数Range(B & row & :B & row).SelectIf Range(B & row).MergeCells Then With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With rangrows = Cells(row, col).MergeArea.Rows.Count 返回当前合并格行数 Selection.UnMerge 撤销合并格 Do While i rangrows - 1 将撤销合并格后空格赋合并前的数值 Range(B & row + i).Select Selection.Copy Range(B & row + i + 1).Select ActiveSheet.Paste i = i + 1 Loop row = row + iEnd Ifi = 0row = row + 1LoopRange(B7).SelectEnd SubSub 读取日成本异常数据() 读取日成本异常数据 Macro 宏由 许长安 录制，时间: 2016-2-25 Range(C7).Select Application.WindowState = xlMaximized Windows(钢后实际价汇总_到钢种.xls).Activate Dim i, h, m, n, j, k As Integer Dim sFullPath As String Dim sFileName As String Dim MyFile As Object col = 17 row = 2 以下测试 日期控件 Cells(1, 13) = DTPicker1.Value MsgBox DTPicker1.Value With ActiveWorkbook.Worksheet MsgBox Sheets(Sheet1).DTPicker1.Value MsgBox CStr(Sheets(Sheet1).DTPicker1.Value) MsgBox Format(Sheets(Sheet1).DTPicker1.Value, yyyymmdd) sFileName = 钢后实际价汇总_到钢种 & Format(Sheets(Sheet1).DTPicker1.Value, yyyymmdd) MsgBox sFileName End With sFileName = 钢后实际价汇总_到钢种 & Format(DTPicker1.Value, yyyymmdd) 指定需要拷贝数据的日期 以上测试日期控件 Set MyFile = CreateObject(Scripting.FileSystemObject) sFullPath = ThisWorkbook.Path 返回当前文件路径 Format(Date, yyyy年m月d日) 当前年月日 oFileName = 钢后实际价汇总_到钢种 oFileName = ActiveWorkbook.Name sFileName = 钢后实际价汇总_到钢种 & Format(Date - 1, yyyymmdd) 指定需要拷贝数据的日期 sFileName = 钢后实际价汇总_到钢种 & Format(Sheets(Sheet1).DTPicker1.Value, yyyymmdd) 指定需要拷贝数据的日期 MsgBox (Prompt ,Buttons ,Title ,Helpfile,Context) MsgBox sFullPath & sFileName & .xls MsgBox 当前打开的文件： & oFileName k = MsgBox(sFullPath & sFileName & .xls, 1, 提示：即将打开的文件!) If k = 2 Then Exit Sub 退出本程序 End If If MyFile.FileExists(sFullPath & & sFileName & .xls) = True Then 判定指定文件是否存在 i = OpenExcelFile(sFullPath, sFileName, 1, ) 打开数据源文件 Else MsgBox 指定文件： & sFileName & 不存在！ Exit Sub Application.Quit 退出当前应用程序 End If Windows(sFileName).Activate 激活数据源文件 fileproce 调用过程：处理原始文件 Windows(钢后实际价汇总_到钢种.xls).Activate MsgBox ActiveSheet.UsedRange.Rows.Count() 当前工作表总行数 开始复制数据： j = 7 原始数据表第7行开始 Windows(sFileName & .xls).Activate m = ActiveSheet.UsedRange.Rows.Count() 原始数据表总行数 Windows(oFileName & .xls).Activate n = ActiveSheet.UsedRange.Rows.Count() 目标数据表总行数 Do While j m 31 测试用 实际用 0.05 Or fff 0 And Cells(j, 16).Value And Cells(j, 4).Value Then 数据计较 且不能为空 时 Range(B & j & : & I & j).Select Selection.Copy Windows(oFileName & .xls).Activate Range(B & n + 1).Select ActiveSheet.Paste Windows(sFileName & .xls).Activate Range(P & j & : & Q & j).Select Selection.Copy Windows(oFileName & .xls).Activate Range(J & n + 1).Select Range(J & n + 1 & : & K & n + 1).Select ActiveSheet.Paste 填上颜色 Range(J & n + 1).Select If Format(Cells(n + 1, 10), #,#0.000) 0.1 Or Format(Cells(n + 1, 10), #,#0.000) 0.1 Or Format(Cells(n + 1, 11), #,#0.000) 0.05 Or Format(Cells(n + 1, 11), #,#0.000) -0.05 Then Selection.Interior.ColorIndex = 36 置为黄色 Else Selection.Interior.ColorIndex = 35 置为蓝色 End If Cells(n + 1, 1).Value = Format(Date - 1, yyyymmdd) 记录指定需要拷贝数据的日期 Cells(n + 1, 1).Value = Format(Sheets(Sheet1).DTPicker1.Value, yyyymmdd) 记录指定需要拷贝数据的日期 Range(A & n - 1 & : & A & n - 1).Select Selection.Copy Range(A & n + 1).Select Selection.PasteSpecial Paste:=xlPasteFormats,