Question

我有4个单独的工作表 - 一个名为main，一个名为Data 1，一个名为Data 2，另一个名为Data 3。

我在主页上有一个按钮，当我点击使用相同的功能转换所有三个数据表但我坚持的是我还希望它将3个数据表转换为3个单独的CSV文件使用名称“output_data1.csv”，“output_data2.csv”和“output_data3.csv”，但如果我稍后添加它，它还可以灵活地处理另一个数据表4。

有什么方法可以做到这一点吗？我坚持的主要事情是能够重命名它，但保持原始的excel文件不变。

Sub DumpOutput()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Main" Then
        ProcessData ws
    End If
Next ws
End Sub

Sub ProcessData(ByRef w As Worksheet)
Dim N As Long, wf As WorksheetFunction, M As Long
Dim i As Long, J As Long
Dim rng As Range
Dim Temp
Dim nams As Variant
Dim F
Dim Dex As Integer
 N = Columns.Count
 M = Rows.Count
With w
    Set wf = Application.WorksheetFunction

         Application.ScreenUpdating = False

    For i = N To 1 Step -1
           If wf.CountBlank(.Columns(i)) <> M Then Exit For
    Next i

    For J = i To 1 Step -1
        If wf.CountBlank(.Columns(J)) = M Then
            .Cells(1, J).EntireColumn.Delete
        End If
    Next J

    For J = M To 1 Step -1
         If wf.CountBlank(.Rows(J)) <> N Then Exit For
    Next J

        For i = J To 1 Step -1
            If wf.CountBlank(.Rows(i)) = N Then
        .Cells(1, i).EntireRow.Delete
            End If
        Next i

        Application.ScreenUpdating = True

    nams = Array("NAME", "TICKER", "PRICE", "CURRENCY", "ISIN", "TYPE")
    Set rng = .Range("A1").CurrentRegion
    For i = 1 To rng.Columns.Count
        For J = i To rng.Columns.Count
            For F = 0 To UBound(nams)
                If nams(F) = rng(J) Then Dex = F: Exit For
            Next F

        If F < i Then
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        End If
        Next J
    Next i



    .Range("f1:f13") = Application.Transpose(Array("TYPE", "Stock", "Stock", "Stock", "Index", "Stock", "Stock", "Stock", "Index", "Stock", "Stock", "Stock", "Index"))
    w.Cells.EntireColumn.AutoFit
    Debug.Print .Name
End With
End Sub

Answer 1

鉴于您正在将工作表直接传递给该函数，您可以根据需要对Sub进行一些小的更改，无论您输入的是多少工作表：

Sub ProcessData(ByRef w As Worksheet)
Dim N As Long, wf As WorksheetFunction, M As Long
Dim i As Long, J As Long
Dim rng As Range
Dim Temp
Dim nams As Variant
Dim F
Dim Dex As Integer
 N = Columns.Count
 M = Rows.Count
With w
    Set wf = Application.WorksheetFunction

         Application.ScreenUpdating = False

    For i = N To 1 Step -1
           If wf.CountBlank(.Columns(i)) <> M Then Exit For
    Next i

    For J = i To 1 Step -1
        If wf.CountBlank(.Columns(J)) = M Then
            .Cells(1, J).EntireColumn.Delete
        End If
    Next J

    For J = M To 1 Step -1
         If wf.CountBlank(.Rows(J)) <> N Then Exit For
    Next J

        For i = J To 1 Step -1
            If wf.CountBlank(.Rows(i)) = N Then
        .Cells(1, i).EntireRow.Delete
            End If
        Next i

        Application.ScreenUpdating = True

    nams = Array("NAME", "TICKER", "PRICE", "CURRENCY", "ISIN", "TYPE")
    Set rng = .Range("A1").CurrentRegion
    For i = 1 To rng.Columns.Count
        For J = i To rng.Columns.Count
            For F = 0 To UBound(nams)
                If nams(F) = rng(J) Then Dex = F: Exit For
            Next F

        If F < i Then
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        End If
        Next J
    Next i



    .Range("f1:f13") = Application.Transpose(Array("TYPE", "Stock", "Stock", "Stock", "Index", "Stock", "Stock", "Stock", "Index", "Stock", "Stock", "Stock", "Index"))
    w.Cells.EntireColumn.AutoFit
    Debug.Print .Name
End With

' Now make a copy of the Worksheet to a new workbook
w.Copy
' And save the newly created workbook with that sheet as a csv
ActiveWorkbook.SaveAs Filename:="C:\myPath\" & w.Name & ".csv", _
                  FileFormat:=xlCSV
End Sub

为VBA中的所有工作表输出多个CSV文件并重命名

1 个答案: