Question

我发现这段代码为我的工作提供了极大的帮助。我想对它进行更多自定义，而对于我自己的一生，我无法使其正常工作。我完全没有编码知识，所以我认为我可以从这个社区中获得一些帮助。

我想添加一些内容，以便在保存文件时将其保存为.CSV文件格式。我的代码如下所示。

Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeToCopy As Range
  Dim RangeOfHeader As Range        'data (range) of header row
  Dim WorkbookCounter As Integer
  Dim RowsInFile                    'how many rows (incl. header) in new files?

  Application.ScreenUpdating = False

  'Initialize data
  Set ThisSheet = ThisWorkbook.ActiveSheet
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 101                   'as your example, just 1000 rows per file

  'Copy the data of the first row (header)
  Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns))

  For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1
    Set wb = Workbooks.Add

  'Paste the header row in new file
    RangeOfHeader.Copy wb.Sheets(1).Range("A1")

  'Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 2, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A2")

  'Save the new workbook, and close it
    wb.SaveAs ThisWorkbook.Path & "\file " & WorkbookCounter
    wb.Close

  'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub

Answer 1

Juan，据我了解，您的唯一目标是另存为CSV。如果是这样，除了 SaveAs 方法中缺少第二个参数外，您所做的一切都是正确的； FileFormat。

例如：

Sub SaveAsCSV()

Dim wb As Workbook

Set wb = ThisWorkbook

Application.DisplayAlerts = False
wb.SaveAs ThisWorkbook.Path & "\" & "name1", xlCSV
Application.DisplayAlerts = True

End Sub

导出列表并将其另存为.CSV文件

1 个答案: