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

LangQueS

9楼就是包含格式的代码

sunya_0529

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

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

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

bluewindeva

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

bluewindeva

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

guojianlin1985

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

sunya_0529

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

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

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

复制代码

海婷

先做记号,有空慢慢学

wenwen000424

作个记号后学习。

scmycgx

这个也来学习一下