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

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

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

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

---

我发现的所有其他解决scheme涉及Python或其他脚本语言，我找不到任何具体的自动从Excel工作表中提取一列，并保存为一个单独的CSV。

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

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

条件/限制：

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

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

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

资源：
链接到工作表
链接到更新的工作簿
链接到3.csv （样本输出CSV）

---

视觉例子：

查看工作表数据的组织结构

我想如何保存CSV文件（数字迭代，所以其他程序将很容易加载所有的CSV文件与循环）

每个CSV文件的内容将如何显示的示例 – （单元格A1是“标题”值，单元格B1是所有关键字（位于主Excel表单中的标题下面）集合在一个单元格中，由引号“”）

代码几乎可以工作，但是除了“AA”和“Word Frequency”以外，只能循环使用2个工作表，而不是所有工作表：
我正在使用的最新工作簿

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()跨所有工作表运行。
传递countervariables是不正确的，因为它是一个Public （全局）variables。 如果它在任何子程序中被改变，新的值将被保存在variables被调用的任何地方。

在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