Question

我需要一个宏来导出Excel文件中的工作表，以便它们是逗号分隔的文本文件，如下所示：

领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，领域，字段

我有一个在文件上运行的以下宏但需要它来执行以下操作：

1）它应该在具有多个工作表的Excel文件中的活动打开工作表上运行。 2）应提示用户使用唯一名称保存新文本文件。 3）将文本文件放在桌面上或指定的文件夹中。

以下是宏：

Sub WriteCSVFile()

Dim ws As Worksheet
Dim fName As String, Txt1 As String
Dim fRow As Long, lRow As Long, Rw As Long
Dim Col As Long

Set ws = Sheets("Sheet1")
fName = "C:\yourpath\yourfilename.csv"
fRow = 2
Col = 2
Txt1 = ""

    With ws
        lRow = .Cells(Rows.Count, Col).End(xlUp).Row

        Open fName For Output As #1

            For Rw = fRow To lRow
                Txt1 = .Range(.Cells(Rw, Col), .Cells(Rw, Col))
                    If Rw = lRow Then
                        Print #1, Txt1
                    Else
                        Print #1, Txt1 & ", ";
                    End If
            Next Rw

        Close #1

        MsgBox ".csv file exported"

    End With
End Sub

上面的问题是我必须为每个工作表修改宏。我希望在任何打开的工作表上都可以运行而无需修改。

Answer 1

试试这个：

Sub WriteCSVFile()

Dim ws As Worksheet
Dim fName As String, Txt1 As String
Dim fRow As Long, lRow As Long, Rw As Long
Dim Col As Long

For Each ws In ActiveWorkbook.Sheets
    fName = Application.GetSaveAsFilename("C:\yourpath\" & ws.Name & ".csv")
    fRow = 2
    Col = 2
    Txt1 = ""
    With ws
        lRow = .Cells(Rows.Count, Col).End(xlUp).Row

        Open fName For Output As #1

            For Rw = fRow To lRow
                Txt1 = .Range(.Cells(Rw, Col), .Cells(Rw, Col))
                    If Rw = lRow Then
                        Print #1, Txt1
                    Else
                        Print #1, Txt1 & ", ";
                    End If
            Next Rw

        Close #1

        MsgBox ".csv file exported"

    End With
Next ws
End Sub

它遍历工作簿中的工作表并打开GetSaveAsFileName对话框，并将当前工作表名称作为默认值。

Answer 2

并向Dave致谢，并提供了几个装饰。将允许您打开源文件并在关闭它之前遍历其所有工作表。 .csv文件的文件名与工作表选项卡名称相同（因此不需要用户提示）。代码将“exports”的日志条目写入ThisWorkbook中名为“Log”的工作表。

在此代码中添加您自己的“fOutPath”，并将一个名为“Log”的工作表添加到您将存储/运行此代码的文件中。假设源数据位于每个工作表中的相同位置，从当前设置为“B2”的（fRow，Col）开始的单个列中。

Sub WriteCSVFile2()

Dim wb As Workbook
Dim ws As Worksheet
Dim fd As Object
Dim fOutName As String, fInName As String
Dim fOutPath As String, Txt1 As String
Dim fRow As Long, lRow As Long, Rw As Long
Dim Col As Long, logNextRow As Long, logCol As Long

fOutPath = yourpath
logCol = 1  'col A

'Open file select dialog
Set fd = Application.FileDialog(msoFileDialogOpen)
fd.AllowMultiSelect = False
fd.Show
fInName = fd.SelectedItems(1)

    If Not fInName = "" Then
        'Open the source data file; need a check if this wbook is already open
        Set wb = Workbooks.Open(fInName)

            'Iterate through the sheets collection to write data to .csv file(s)
            For Each ws In Worksheets
                'Set csv output file name as ws Tab name
                fOutName = fOutPath & ws.Name & ".csv"
                'You could 'detect' fRow and Col from the worksheet?
                fRow = 2
                Col = 2
                Txt1 = ""
                    'Write csv file for this sheet
                    With ws
                        lRow = .Cells(Rows.Count, Col).End(xlUp).Row

                        Open fOutName For Output As #1

                            For Rw = fRow To lRow
                                Txt1 = .Range(.Cells(Rw, Col), .Cells(Rw, Col))
                                    If Rw = lRow Then
                                        Print #1, Txt1
                                    Else
                                        Print #1, Txt1 & ", ";
                                    End If
                            Next Rw

                        Close #1
                    End With

                    'Write an Output Log to a Sheet called "Log"
                    With ThisWorkbook.Sheets("Log")
                        logNextRow = .Cells(.Rows.Count, logCol).End(xlUp).Row + 1
                        .Cells(logNextRow, logCol).Value = "From: " & wb.Name
                        .Cells(logNextRow, logCol).Offset(0, 1).Value = _
                        " To: " & fOutPath & ws.Name & ".csv"
                        .Cells(logNextRow, logCol).Offset(0, 2).Value = Now()
                        .Range(.Cells(logNextRow, logCol), .Cells(logNextRow, logCol).Offset(0, 2)).Columns.AutoFit
                    End With

            Next ws

        'Close source data workbook
        wb.Close SaveChanges:=False

        'Confirm export to user
        MsgBox ".csv file(s) exported"

    End If

End Sub

用于从具有多个工作表的Excel文件导出文本文件的宏

2 个答案: