（Excel）如何将每列提取（并将其保存）为自己的 CSV 文件？

Question

是否可以将工作表中的每一列保存为自己的 CSV 文件？这是我想要完成的主要事情，尽管还有更多细节。

编辑：代码几乎可以工作，但由于某种原因，它似乎只循环了大约 30 个工作表中的两个。它输出 125-135 个 csv 文件（不知道为什么会变化？），但是它应该输出接近 1000 个 csv 文件。

知道为什么代码没有在所有工作表中循环吗？（底部代码 + 更新的工作簿）

---

我发现的所有其他解决方案都涉及 python 或其他脚本语言，我找不到任何特定于自动从 Excel 工作表中提取列并将其保存为单独的 CSV 的内容。

目标：
（在所有工作表中，“AA”和“词频”除外）
将每列（从 E 列开始）保存为自己的 CSV 文件

目的：
创建单独的数据 CSV 文件以供其他程序进一步处理。 （这个程序需要这样组织的数据）

条件/约束：

1. 每个工作表的列数会有所不同。第一列将始终是 E 列

2. 为每个单独的 CSV 编号（1.csv、2.csv、3.csv……9999.csv），并保存在 excel 文件的工作文件夹中。迭代数字 (+1)，以免覆盖其他 CSV

3.格式化新的CSV文件，使第一行（标题）保持原样，其余单元格（标题下方）用引号括起来，并粘贴到第2列的第一个单元格中

资源：
Link to worksheet
Link to updated workbook
Link to 3.csv（样本输出 CSV）

---

视觉示例：

查看工作表数据的组织方式


我如何尝试保存 CSV 文件（数值迭代，因此其他程序很容易通过循环加载所有 CSV 文件）


每个 CSV 文件内容的外观示例 - （单元格 A1 是“标题”值，单元格 B1 是所有关键字（存在于主 excel 表中的标题下方）聚集到一个单元格中，包含用引号 "")

几乎可以工作的代码，但只循环 2 个工作表，而不是“AA”和“词频”之外的所有工作表：
Newest workbook I'm working with

Option Explicit

Public counter As Integer


Sub Create_CSVs_AllSheets()

    Dim sht 'just a tmp var

    counter = 1                 'this counter will provide the unique number for our 1.csv, 2.csv.... 999.csv, etc
    appTGGL bTGGL:=False
    For Each sht In Worksheets  ' for each sheet inside the worksheets of the workbook
        If sht.Name <> "AA" And sht.Name <> "Word Frequency" Then
        'IF sht.name is different to AA AND sht.name is diffent to WordFrecuency THEN

        'TIP:
        'If Not sht.Name = noSht01 And Not sht.Name = noSht02 Then 'This equal
        'IF (NOT => negate the sentence) sht.name is NOT equal to noSht01 AND
        '                                sht.name is NOT equal to noSht02 THEN

            sht.Activate 'go to that Sheet!
            Create_CSVs_v3 (counter) 'run the code, and pass the counter variable (for naming the .csv's)


        End If '
    Next sht 'next one please!
    appTGGL
End Sub

Sub Create_CSVs_v3(counter As Integer)
Dim ws As Worksheet, i As Integer, j As Integer, k As Integer, sHead As String, sText As String
Set ws = ActiveSheet    'the sheet with the data, _
                        'and we take the name of that sheet to do the job

For j = 5 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
     If ws.Cells(1, j) <> "" And ws.Cells(2, j) <> "" Then
          sHead = ws.Cells(1, j)
          sText = ws.Cells(2, j)
          If ws.Cells(rows.Count, j).End(xlUp).Row > 2 Then
               For i = 3 To ws.Cells(rows.Count, j).End(xlUp).Row   'i=3 because above we defined that_
                                                                    'sText = ws.Cells(2, j) above_
                                                                    'Note the "2" above and the sText below
                    sText = sText & Chr(10) & ws.Cells(i, j)
                    Next i
               End If
          Workbooks.Add
          ActiveSheet.Range("A1") = sHead
          'ActiveSheet.Range("B1") = Chr(34) & sText & Chr(34)
          ActiveSheet.Range("B1") = Chr(10) & sText 'Modified above line to start with "Return" character (Chr(10))
          'instead of enclosing with quotation marks (Chr(34))

          ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & counter & ".csv", _
          FileFormat:=xlCSV, CreateBackup:=False 'counter variable will provide unique number to each .csv

          ActiveWorkbook.Close SaveChanges:=True
          'Application.Wait (Now + TimeValue("0:00:01"))
          counter = counter + 1                 'increment counter by 1, to make sure every .csv has a unique number
          End If
     Next j

Set ws = Nothing
End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Debug.Print Timer
    Application.ScreenUpdating = bTGGL
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
End Sub

知道最新代码有什么问题吗？
任何帮助将不胜感激。

Answer 1

第一眼，更改以下代码

If sht.Name <> "AA" And sht.Name <> "Word Frequency" Then

到

If sht.Name <> "AA" OR sht.Name <> "Word Frequency" Then

回来，我们可以看得更远。 HTH。

Answer 2

在@Elbert Villarreal 的帮助下，我能够让代码正常工作。

我在示例中的最后一个（几乎可以工作的）代码是（几乎）正确的，Elbert 指出：

在Create_CSVs_AllSheets() 子程序内：
我需要将sht.Index 传递给Create_CSVs_v3() 子例程，以使Create_CSVs_v3() 在所有工作表中运行。
传递counter 变量是不正确的，因为它是Public（全局）变量。如果它在任何子例程中发生更改，则新值将保留在调用该变量的任何其他位置。

在Create_CSVs_v3() 子程序内：
需要Set ws = Sheets(shtIndex) 才能将其设置为确切的工作表，而不仅仅是活动的工作表。

工作代码：

Option Explicit

Public counter As Integer

Sub Create_CSVs_AllSheets()

    Dim sht As Worksheet        '[????????????????]just a tmp var[????????????????]

    counter = 1                 'this counter will provide the unique number for our 1.csv, 2.csv.... 999.csv, etc                         

    appTGGL bTGGL:=False

    For Each sht In Worksheets  ' for each sheet inside the worksheets of the workbook

        If sht.Name <> "AA" And sht.Name <> "Word Frequency" Then


        'IF sht.name is different to AA AND sht.name is diffent to WordFrecuency THEN

        'TIP:

        'If Not sht.Name = noSht01 And Not sht.Name = noSht02 Then 'This equal

        'IF (NOT => negate the sentence) sht.name is NOT equal to noSht01 AND

        '                                sht.name is NOT equal to noSht02 THEN

        sht.Activate 'go to that Sheet!

        Create_CSVs_v3 sht.Index 'run the code, and pass the counter variable (NOT for naming the .csv's)

                                 'Run the code, and pass the sheet.INDEX of the current sheet to select that sheet

                                 'you will affect the counter inside Create_CSVs_v3

        End If '

    Next sht 'next one please!

    appTGGL

End Sub



Sub Create_CSVs_v3(shtIndex As Integer)

    Dim ws As Worksheet

    Dim i As Integer

    Dim j As Integer

    Dim k As Integer

    Dim sHead As String

    Dim sText As String



    Dim maxCol As Long

    Dim maxRow As Long

    Set ws = Sheets(shtIndex)    'Set the exact sheet, not just which one is active.

                                 'and then you will go over all the sheets

    'NOT NOT Set ws = ActiveSheet    'the sheet with the data, _

                            'and we take the name of that sheet to do the job



    maxCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    For j = 5 To maxCol

        If ws.Cells(1, j) <> "" And ws.Cells(2, j) <> "" Then 'this IF is innecesary if you use

                                                               'ws.Cells(1, Columns.Count).End(xlToLeft).Column

                                                               'you'r using a double check over something that you check it

            sHead = ws.Cells(1, j)

            sText = ws.Cells(2, j)



            If ws.Cells(rows.Count, j).End(xlUp).Row > 2 Then

                maxRow = ws.Cells(rows.Count, j).End(xlUp).Row 'Use vars, instead put the whole expression inside the

                                                               'for loop



                For i = 3 To maxRow   'i=3 because above we defined that_

                                      'sText = ws.Cells(2, j) above_

                                      'Note the "2" above and the sText below

                     sText = sText & Chr(10) & ws.Cells(i, j)

                Next i

            End If

            Workbooks.Add

            ActiveSheet.Range("A1") = sHead

            'ActiveSheet.Range("B1") = Chr(34) & sText & Chr(34)

            ActiveSheet.Range("B1") = Chr(10) & sText 'Modified above line to start with "Return" character (Chr(10))

                                                      'instead of enclosing with quotation marks (Chr(34))



            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & counter & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False 'counter variable will provide unique number to each .csv



            ActiveWorkbook.Close SaveChanges:=True

                                                  'Application.Wait (Now + TimeValue("0:00:01"))

            counter = counter + 1                 'increment counter by 1, to make sure every .csv has a unique number

        End If

    Next j

    Set ws = Nothing

End Sub



Public Sub appTGGL(Optional bTGGL As Boolean = True)

    Debug.Print Timer

    Application.ScreenUpdating = bTGGL

    Application.EnableEvents = bTGGL

    Application.DisplayAlerts = bTGGL

    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)

End Sub