Question

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

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

有关为什么代码没有在所有工作表中循环的任何想法？（底部的代码+更新的工作簿）

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

目标：
（除了“AA”和“Word Frequency”之外的所有工作表）将每列（从E列开始）保存为自己的CSV文件

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

条件/限制：

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

2.为每个CSV（1.csv，2.csv，3.csv ...。9999.csv）编号，并保存在excel文件的工作文件夹中。迭代数字（+1），这样就不会覆盖其他CSV

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

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

视觉示例：

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

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

每个CSV文件内容的样子示例 - （单元格A1是“标题”值，单元格B1是所有关键字（存在于主Excel工作表中的标题下面）聚集在一个单元格中，包含用引号“”）

几乎正常工作的代码，但只有2个工作表的循环，而不是“AA”和“Word Frequency”之外的所有工作表：
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

Fisrt一眼，改变代码

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

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

2 个答案: