VBA 实例:抓取用友导出数据并计算

0
421

通过抓取用友导出数据,自动计算利息。

Sub auto_analysis()
Dim filepath As String, i As Integer, j As Integer, k As Integer
 filepath = Application.GetOpenFilename("EXCEl Files (*.xls), *.xls*", 0, "选定文件", , False)
 ub = UBound(Split(filepath, "\"))
 Filename = Split(filepath, "\")(ub)
 Sheets.Add after:=Sheets("BASE")
 ActiveSheet.Name = Left(Filename, Len(Filename) - 4)
 With ActiveSheet
 .Range("a1:h1").MergeCells = True
 .Range("a1") = "利息单"
 .Range("a2:h2").MergeCells = True
 .Range("a2") = "单位:" & Left(Filename, Len(Filename) - 4)
 .Range("a3") = "序号"
 .Range("b3") = "款项"
 .Range("c3") = "起息日期"
 .Range("d3") = "结息日期"
 .Range("e3") = "天数"
 .Range("f3") = "年利率"
 .Range("g3") = "利息"
 .Range("h3") = "备注"
 .Range("a1:h3").HorizontalAlignment = xlCenter
 .Range("a1").Activate
 With Selection.Font
 .Name = "宋体"
 .Bold = True
 .Size = 16
 End With
 End With
 Start_date = ThisWorkbook.Sheets("BASE").Cells(1, 2)
 End_date = ThisWorkbook.Sheets("BASE").Cells(1, 3)
 Create_date = ThisWorkbook.Sheets("BASE").Cells(3, 2)
 StrIntrest = ThisWorkbook.Sheets("BASE").Cells(2, 2)
 With Workbooks.Open(filepath)
     m = .Sheets(1).UsedRange.Rows.Count
     For i = 2 To m
      If .Sheets(1).Range("c" & i) <> "" Then '凭证号不为空
      Select_date = DateSerial(2015, .Sheets(1).Range("a" & i), .Sheets(1).Range("b" & i))
      If Select_date > Start_date And Select_date < End_date Then
      k = k + 1
      With Workbooks("Intrest_Com").Sheets(Left(Filename, Len(Filename) - 4))
      .Range("a" & 3 + k) = k '序列号
      If k = 1 Then
      .Range("b" & 3 + k) = Workbooks(Filename).Sheets(1).Range("h" & i - 1)
      .Range("c" & 3 + k) = Start_date
      .Range("d" & 3 + k) = End_date
      .Range("e" & 3 + k) = End_date - .Range("c" & 3 + k) + 1
      .Range("f" & 3 + k) = StrIntrest
      .Range("g" & 3 + k) = StrIntrest * .Range("b" & 3 + k) * .Range("e" & 3 + k) / 360
      '序列号为2
      .Range("a" & 3 + k + 1) = k + 1
      .Range("b" & 3 + k + 1) = Workbooks(Filename).Sheets(1).Range("e" & i) + Workbooks(Filename).Sheets(1).Range("f" & i) * (-1)
      .Range("c" & 3 + k + 1) = Select_date
      Else
      .Range("b" & 3 + k + 1) = Workbooks(Filename).Sheets(1).Range("e" & i) + Workbooks(Filename).Sheets(1).Range("f" & i) * (-1)
      .Range("c" & 3 + k + 1) = Select_date
      End If
      .Range("d" & 3 + k + 1) = End_date
      .Range("e" & 3 + k + 1) = End_date - .Range("c" & 3 + k + 1) + 1
      .Range("f" & 3 + k + 1) = StrIntrest
      .Range("g" & 3 + k + 1) = StrIntrest * .Range("b" & 3 + k + 1) * .Range("e" & 3 + k + 1) / 360
      End With
      'MsgBox Select_date
      End If
      End If
     Next i
    .Close False
 End With
With Workbooks("Intrest_Com").Sheets(Left(Filename, Len(Filename) - 4))
mm = .UsedRange.Rows.Count
.Range("a" & mm + 1) = "合计"
.Range("b" & mm + 1) = Application.WorksheetFunction.Sum(.Range("b4:b" & mm))
.Range("g" & mm + 1) = Application.WorksheetFunction.Sum(.Range("g4:g" & mm))
.Range("a" & mm + 2 & ":h" & mm + 2).MergeCells = True
.Range("a" & mm + 2) = "XXX处" & Format(Create_date, "Long Date") & "制"
.Range("a3:h" & mm + 2).Font.Name = "宋体"
.Range("a3:h" & mm + 2).Font.Size = 12
.Range("a3:h" & mm + 1).Borders.LineStyle = xlContinuous
.Range("a3:a" & mm + 1).HorizontalAlignment = xlCenter
.Range("c3:f" & mm + 1).HorizontalAlignment = xlCenter
.Range("b3:b" & mm + 1).NumberFormat = "0.00"
.Range("g3:g" & mm + 1).NumberFormat = "0.00"
.Range("f3:f" & mm + 1).NumberFormat = "0.00%"
.Range("a2").HorizontalAlignment = xlLeft
.Range("a" & mm + 2).HorizontalAlignment = xlRight
End With
End Sub

Update 2016-01-13:

如遇报错,请在63行、103行Intrest_Com加上后缀.xlsm

上一篇博客新主题上线
下一篇用批处理简单记录工作日志

留言

留言不能为空
怎么称呼您?

验证码 *