提问人:Hassan Shehzad 提问时间:11/11/2023 最后编辑:Mayukh BhattacharyaHassan Shehzad 更新时间:11/11/2023 访问量:71
使用 .xslm 文件中的宏生成多个 CSV 文件
Generate multiple CSV files using macro from .xslm file
问:
我有宏脚本:
- 使用 A 列中的“next”分隔符导出多个 csv 文件,直到找到“stop”。
- 保存每个 csv 文件,其中包含 S 列中的名称文件,对应的行,“文件 1”、“文件 2”、“文件 3”
- 对于每个导出的 .csv,都会复制 .xslm 顶部的列标题,因此 .xlsm 文件不需要在“下一个”之前的每一行中都有重复的标题
- 它确实转义了像“;”这样的分隔符
- 它导出 Unicode 符号
- 它生成CSV文件。
我希望脚本生成多个具有上述相同要求的文件。
下面是宏代码:
Sub export_multiple_CSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim wsCopyRange As Range
Application.ScreenUpdating = False
Set CurrentWB = ActiveWorkbook
On Error Resume Next
Set ws = CurrentWB.Sheets("File")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "The 'File' sheet is missing!"
Application.ScreenUpdating = True
Exit Sub
Else
lastRow = ws.UsedRange.rows.count
Set wsCopyRange = ws.UsedRange
End If
' Initialize variables
Dim sRow As Long, eRow As Long
Dim counter As Long: counter = 1
Dim inSection As Boolean: inSection = False
' Loop through each row in column A
For sRow = 1 To lastRow
If ws.Cells(sRow, 1).value = "next" Then
inSection = True
eRow = sRow - 1
' Check if we are at the last row
If sRow = lastRow Then
eRow = lastRow
End If
ElseIf ws.Cells(sRow, 1).value = "stop" Then
' Check if we are in a section
If inSection Then
' Create a temporary workbook and copy the range
Set TempWB = Application.Workbooks.Add(1)
wsCopyRange.Offset(eRow).Resize(sRow - eRow).Copy
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
' Replace add block here
End With
Application.CutCopyMode = False
' Generate the filename from column S
Dim fName As String: fName = ws.Cells(eRow, 19).value & "_file" & counter & ".csv"
MyFileName = CurrentWB.Path & "\" & fName
' Save the workbook as CSV with UTF-8 encoding
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False
'SaveAsUTF8 MyFileName
TempWB.Close SaveChanges:=False
counter = counter + 1
inSection = False
End If
End If
Next sRow
Application.ScreenUpdating = True
End Sub
我们怎样才能修改这段代码来生成多个文件(我们可以指定要生成多少个文件)。
答:
0赞
taller
11/11/2023
#1
您的代码已接近完成。我做了一些改变。
Option Explicit
Sub export_multiple_CSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim ws As Worksheet
Dim lastRow As Long, ColCount As Long
Dim wsCopyRange As Range
Application.ScreenUpdating = False
Set CurrentWB = ActiveWorkbook
On Error Resume Next
Set ws = CurrentWB.Sheets("File")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "The 'File' sheet is missing!"
Application.ScreenUpdating = True
Exit Sub
Else
Set wsCopyRange = ws.UsedRange
' Get rows # and columns #
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
ColCount = ws.Cells(1, ws.Columns.Count).End(xlToRight).Column
End If
' Initialize variables
Dim sRow As Long, eRow As Long
Dim counter As Long: counter = 0
Dim inSection As Boolean: inSection = False
' Loop through each row in column A
For sRow = 1 To lastRow
If ws.Cells(sRow, 1).Value = "next" Then
inSection = True
eRow = sRow
ElseIf ws.Cells(sRow, 1).Value = "stop" Then
' Check if we are in a section
If inSection Then
' Create a temporary workbook and copy the range
Set TempWB = Application.Workbooks.Add(1)
' Assign value is more efficient than copy / paste
With TempWB.Sheets(1)
.Range("A1:A" & ColCount).Value = wsCopyRange.Range("A1:A" & ColCount).Value
.Range("A2").Resize(sRow - eRow - 1, ColCount).Value = wsCopyRange.Offset(eRow).Resize(sRow - eRow - 1, ColCount).Value
End With
Application.CutCopyMode = False
' Generate the filename from column S (at "next" row) **modify as needed if filename is in other row
Dim fName As String: fName = ws.Cells(eRow, 19).Value & "_file" & counter & ".csv"
MyFileName = CurrentWB.Path & "\" & fName
' Save the workbook as CSV with UTF-8 encoding, ** xlCSVUTF8 for UTF8 csv
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSVUTF8, CreateBackup:=False
TempWB.Close SaveChanges:=False
counter = counter + 1
inSection = False
End If
End If
Next sRow
MsgBox "Export " & counter & " csv files."
Application.ScreenUpdating = True
End Sub
Microsoft 文档:
评论
0赞
Hassan Shehzad
11/11/2023
VBA 是否识别“xlCSVUTF8”。正如它所说,当我运行时没有声明变量。
0赞
taller
11/11/2023
是的。现在是 62 岁。Microsoft文档:> XlFileFormat 枚举 (Excel)。如果你做什么,那么你应该使用。您是否使用 Excel VBA 运行代码?save the workbook as CSV with UTF-8 encoding
FileFormat:=xlCSVUTF8
0赞
Hassan Shehzad
11/11/2023
哦,我明白了。谢谢,但您提供的代码不符合我上面提到的要求。
0赞
taller
11/11/2023
我可以知道哪些要求吗?您介意在帖子中分享示例数据以进行测试吗?
0赞
Hassan Shehzad
11/11/2023
我不确定数据,但这些是要求: 使用A列中的“下一个”分隔符导出多个csv文件,直到找到“stop”。为每个导出的 .csv 复制 .xslm 顶部的列标题,因此 .xlsm 文件不需要在“next”之前的每一行中都有重复的标题,它确实转义了分隔符,例如“;”它导出 Unicode 符号 我上面的代码可以满足所有要求,除了生成多个文件。
评论
corresponding row
next
stop
TempWB.SaveAs ..
For 1 to n: ... :Next