呼唤VBA高手帮忙制作分数发放条

LangQueS · 发表于 2010-8-3 11:45

9楼就是包含格式的代码

sunya_0529 · 发表于 2010-8-3 11:46

向版主学习，也贴一个思路：

Sub 生成分数条()
Application.ScreenUpdating = False
Dim wbkTemp As Workbook, k As Range, i%
With ThisWorkbook.Sheets("Sheet1")
  i = 0
  For Each k In .Range("A3:A" & .[A65536].End(xlUp).Row)
i = i + 1
Set wbkTemp = Workbooks.Add
.Range("A1:O2,A" & k.Row & ":O" & k.Row).Copy wbkTemp.Sheets(1).[A1]
Application.CutCopyMode = False
wbkTemp.SaveAs Filename:= ThisWorkbook.Path & "\" & Format(i, "000") & "-" & k.Value & ".xls"
wbkTemp.Close
  Next
  Set wbkTemp = Nothing
End With
Application.ScreenUpdating = True
MsgBox "分数条全部生成在本文件同目录下！", vbInformation
End Sub

bluewindeva · 发表于 2010-8-3 11:50

版主很细心～呵呵，我还没说，就已经帮我做好带格式的了～谢谢，谢谢

bluewindeva · 发表于 2010-8-3 11:53

还有个问题，不知道能不能实现，现在是每一行单独建立新文件，能不能制定的某几行建立一个文件，比如第3～5行，第49～52行……这样的呢

bluewindeva · 发表于 2010-8-3 11:53

谢谢兄弟的帮忙了～我试试～

guojianlin1985 · 发表于 2010-8-3 17:37

不会吧，这么会就一大堆答案了

sunya_0529 · 发表于 2010-8-3 18:52

原帖由 bluewindeva 于 2010-8-3 11:53 发表
还有个问题，不知道能不能实现，现在是每一行单独建立新文件，能不能制定的某几行建立一个文件，比如第3～5行，第49～52行……这样的呢

其实只要修改一下循环属性就可以做到了，以下代码供参考：
注意，行号区间的输入一定要规范，没有加容错处理，各区间用西文的“,”分隔，两个行号之间用“-”分隔。

Sub 生成分数条()
Dim wbkTemp As Workbook, k As Range, i%, str$, arr1, arr2
str = InputBox("请输入要生成分数条的记录所在的行号区间：" & vbCrLf & "格式如：3-5,7,8,12-25", "请输入数据——")
If str = "" Then Exit Sub
Application.ScreenUpdating = False '关闭屏幕刷新
arr1 = Split(str, ",") '分解行号区间字符串
With ThisWorkbook.Sheets("Sheet1")
For i = 0 To UBound(arr1) '在各行号区间（即“,”分隔的）内循环
arr2 = Split(arr1(i) & "-", "-") '分解行号区间
Set wbkTemp = Workbooks.Add '新建Excel工作薄
.Range("A1:O2,A" & arr2(0) & ":O" & IIf(arr2(1) = "", arr2(0), arr2(1))).Copy wbkTemp.Sheets(1).[A1] '复制对应数据到新建的工作薄中
Application.CutCopyMode = False '取消剪切复制模式
wbkTemp.SaveAs Filename:=ThisWorkbook.Path & "" & Format(i + 1, "000") & "-分数条汇总.xls", FileFormat:=xlExcel8 '保存新建的工作薄
wbkTemp.Close '关闭新建的工作薄
Next
Set wbkTemp = Nothing '释放对象
End With
Application.ScreenUpdating = True '打开屏幕刷新
MsgBox "分数条全部生成在本文件同目录下！", vbInformation
End Sub

复制代码

海婷 · 发表于 2010-8-3 19:55

先做记号,有空慢慢学

wenwen000424 · 发表于 2010-8-4 10:30

作个记号后学习。

scmycgx · 发表于 2010-8-4 22:06

这个也来学习一下

		自动登录	找回密码
密码			免费注册

[求助] 呼唤VBA高手帮忙制作分数发放条

回复 12楼 sunya_0529 的帖子