zoukankan      html  css  js  c++  java
  • VBA 特约导入代码

    '半夜里匆忙写成,第一次用VBA,只是实现功能,未做性能优化,有时间要重写一下。

    Sub
    Fighting() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim Cell As Range, FirstAddress As String Dim temp As Long Dim c As Long Dim tempValue As Long Dim d As Long Dim str As String Dim RowCount As Long Dim tempRow As Long Dim tempStr As String Dim struNo As Long Dim commentRow As Long Dim findRow As Range Dim excelApp, excelWB As Object Dim savePath As String '机构号 With Sheet1 RowCount = LastRow() For c = 1 To RowCount str = .Cells(c, 1).Value If Len(str) > 0 Then str = Mid(str, 5, 6) .Cells(c, 2) = str End If Next End With '根据机构号,查询对应的行数,放在C列 With Sheet1 For c = 1 To RowCount If .Cells(c, 2).Value > 0 Then temp = .Cells(c, 2).Value '查询行 With Sheet3 For Each Cell In .Range("A1:A131").Cells If Cell.Value = temp Then tempValue = .Cells(Cell.Row, Cell.Column + 1).Value End If Next End With .Cells(c, 3) = tempValue End If Next End With '根据行数,生成新的工作表2 With Sheet1 tempRow = 1 For c = 1 To RowCount If .Cells(c, 3).Value > 0 Then temp = .Cells(c, 3).Value '行数 str = .Cells(c, 1).Value '单号 struNo = .Cells(c, 2).Value '机构号 '查询所在行 'Set findRow = Sheet4.Cells.Find(what:=struNo, LookIn:=xlValues) commentRow = Sheet4.Cells.Find(what:=struNo, LookIn:=xlValues).Row With Sheet2 For d = 1 To temp .Cells(tempRow, 1).NumberFormatLocal = "@" .Cells(tempRow, 1).ShrinkToFit = True .Cells(tempRow, 1).Value = str .Cells(tempRow, 2).Value = 0 .Cells(tempRow, 3).Value = d - 1 '取特约内容 .Cells(tempRow, 4).Value = Sheet4.Cells(commentRow + d - 1, 3) tempRow = tempRow + 1 Next End With End If Next End With '将结果输出到新文件 Set excelApp = CreateObject("Excel.Application") Set excelWB = excelApp.Workbooks.Add excelApp.DisplayAlerts = False savePath = ActiveWorkbook.Path & "\SLBPS_学生险特约导入_2012-XX-XX.xls" excelWB.SaveAs savePath excelApp.Quit Workbooks.Open savePath '复制 Sheet2.Copy Before:=Workbooks("SLBPS_学生险特约导入_2012-XX-XX.xls").Sheets(1) With Workbooks("SLBPS_学生险特约导入_2012-XX-XX.xls").Sheets(1) Sheets(1).Name = "学生险特约" Rows(1).Insert Range("a1") = "CNTR_NO" Range("b1") = "IPSN_NO" Range("c1") = "SPE_NO" Range("d1") = "SPE_DETAIL" Columns(1).ColumnWidth = 25 '保存 Workbooks("SLBPS_学生险特约导入_2012-XX-XX.xls").Close SaveChanges:=True End With '删除临时数据 Sheet1.Columns(3).Delete Sheet1.Columns(2).Delete Sheet2.Columns(4).Delete Sheet2.Columns(3).Delete Sheet2.Columns(2).Delete Sheet2.Columns(1).Delete '更新UI Application.ScreenUpdating = True MsgBox "宏命令执行完成, 文件生成成功!" End Sub Function LastRow() As Long Dim ix As Long ix = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count LastRow = ix End Function
  • 相关阅读:
    apache安装错误error: APR not found解决办法
    (总结)Nginx配置文件nginx.conf中文详解
    多级反向代理下,Java获取请求客户端的真实IP地址多中方法整合
    x-forwarded-for的深度挖掘
    hashcode与字符串
    千万不要误用 java 中的 HashCode 方法
    浅谈Java中的hashcode方法
    MySQL中concat函数
    mysql prepare语句使用
    修改表结构
  • 原文地址:https://www.cnblogs.com/surong/p/2679678.html
Copyright © 2011-2022 走看看