Public Sub QqYunContactTransferCsvFile()
'应用程序设置
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual '错误处理
'On Error GoTo ErrHandler '计时器
Dim StartTime, UsedTime As Variant
StartTime = VBA.Timer '变量声明
Dim Wb As Workbook
Dim Sht As Worksheet
Dim Rng As Range
Dim Arr As Variant
Dim EndRow As Long
Const SplitCount As Long = 100
Dim RecordIndex As Long
Dim FileCount As Long
Dim EachLine As String
Dim WholeLine As String
Dim i As Long, j As Long
Dim HeadLine As String '实例化对象
Set Wb = Application.ThisWorkbook Set Sht = Wb.Worksheets("通讯录") With Sht
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("A1:Y" & EndRow)
Arr = Rng.Value
RecordIndex = 0
FileCount = 0
HeadLine = ""
For j = LBound(Arr, 2) To UBound(Arr, 2)
HeadLine = HeadLine & """" & Arr(1, j) & ""","
Next j
WholeLine = HeadLine For i = LBound(Arr) + 1 To UBound(Arr)
RecordIndex = RecordIndex + 1
EachLine = ""
For j = LBound(Arr, 2) To UBound(Arr, 2)
EachLine = EachLine & """" & Arr(i, j) & """," '有双引号
'EachLine = EachLine & Arr(i, j) & ","'无双引号
Next j
WholeLine = WholeLine & EachLine & vbCrLf If RecordIndex Mod SplitCount = (SplitCount - 1) Or i = UBound(Arr) Then '生成文件的条件
FileCount = FileCount + 1
Open Wb.Path & "\" & FileCount & ".csv" For Output As #1 '生成CSV文件
Print #1, WholeLine '写入CSV的内容
Close #1 '关闭文件句柄
WholeLine = HeadLine
End If Next i
End With '运行耗时
UsedTime = VBA.Timer - StartTime ErrorExit: '错误处理结束,开始环境清理
Set Wb = Nothing
Set Sht = Nothing
Set Rng = Nothing Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
ErrHandler:
If Err.Number <> 0 Then
MsgBox Err.Description & "!", vbCritical, "错误提示!"
'Debug.Print Err.Description
Err.Clear
Resume ErrorExit
End If
End Sub

  

最新文章

  1. [bzoj1670][Usaco2006 Oct]Building the Moat
  2. JavaScript学习笔记7 之DOM文档对象模型
  3. [MacOS] 终端使用ssh时,中文乱码问题处理
  4. 开个帖,开始学习shell编程
  5. DLUTOJ 1033 Matrix
  6. Linux下搭建svn服务器(转)
  7. Mac环境下用Java(Sikuli+Robot)实现页游自动化
  8. 人生新开始&mdash;&mdash;第一天上班
  9. css3图片垂直居中
  10. POJ1988 Cube stacking(非递归)
  11. 不平衡数据下的机器学习方法简介 imbalanced time series classification
  12. win10家庭版安装Docker for Windows
  13. javascript高级
  14. 2018-7-17-随笔-params和ref、out用法、事件访问器
  15. Laravel 5.5 迁移报错:General error: 1215 Cannot add foreign key constraint
  16. ubuntu安裝 R RStudio
  17. JavaScript基础入门教程(二)
  18. elementUI中的el-form怎么使用正则进行验证
  19. [bzoj2002][Hnoi2010]Bounce弹飞绵羊——分块
  20. Dynamic Rankings(整体二分)

热门文章

  1. Linux命令: 向文件写内容,编辑文件,保存文件,查看文件,不保存文件
  2. linux centos系统下升级python版本
  3. C++ Word Count 发布程序
  4. Git本地仓库与远程github同步的时候提示fatal: remote origin already exists 错误解决办法
  5. 解析分布式锁之Redis实现(二)
  6. (五)使用GitHub的前期准备
  7. Educational Codeforces Round 21 Problem F (Codeforces 808F) - 最小割 - 二分答案
  8. IOS学习基础
  9. C# 计算传入的时间距离今天的时间差
  10. CSS布局总结及实际应用中产生的问题