EXCEL中以A列单元格中的数据为文件名,生成新excel文件,如何编写VBA?
发布网友
发布时间：2022-04-28 22:17
共3个回答
热心网友
时间：2022-06-23 23:29
'设置当前活动工作表
Set s = ThisWorkbook.ActiveSheet
'获取当前工作表行数
rc = s.Range("A1").CurrentRegion.Rows.Count
'初始化源文件行和列、新建文件的行、新建文件数
Dim r, c, b_r, b_count As Integer
b_count = 0
'初始化文件名
Dim f As String
'初始化程序结束标志
Dim sub_end As String
sub_end = "N"
Do While sub_end = "N"
f = "None"
'查找未保存的姓名
For r = 2 To rc
If s.Cells(r, 5).Value = "" Then
f = s.Cells(r, 1).Value
Exit For
End If
Next
If f = "None" Then Exit Do '没有未保存的人员信息
Set b = Workbooks.Add
'写标题
With b
For c = 1 To 4
.ActiveSheet.Cells(1, c).Value = s.Cells(1, c).Value
Next
End With
b_r = 2 '新建工作簿中的行
For r = 2 To rc
If s.Cells(r, 1).Value = f And s.Cells(r, 5) = "" Then
'写入一条数据
With b
For c = 1 To 4
.ActiveSheet.Cells(b_r, c).Value = s.Cells(r, c).Value
Next
End With
b_r = b_r + 1
s.Cells(r, 5).Value = "OK" '标记已经处理过的记录
End If
Next
If b_r = 2 Then
b.Close SaveChanges:=False '无数据传入，不保存关闭新建窗口
sub_end = "Y" '跳出循环，结束程序
Else
'保存文件至d盘根目录
b.SaveAs Filename:="d:\" + f + ".xls"
b.Close '关闭文件
b_count = b_count + 1
MsgBox "第" + CStr(b_count) + "个文件【d:\" + f + ".xls】已经保存成功！", vbOKOnly, "提示:"
End If
Loop
If b_count = 0 Then
MsgBox "没有任何文件生成！" + Chr(13) + "如果您需要重新生成文件，将工作簿中" + Chr(13) + "第五列[E]中的所有“OK”删除即可", vbOKOnly, "提示:"
Else
MsgBox "所有文件已经保存完毕，共创建了" + CStr(b_count) + "个文件！", vbOKOnly, "提示:"
End If
End Sub
热心网友
时间：2022-06-23 23:30
热心网友
时间：2022-06-23 23:30
