Question

我想知道是否有人可以帮助我。

使用我在网上找到的脚本＆＃39; base＆＃39;我已经在下面写了这个查询。

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?
  Dim fNameAndPath As Variant


  fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Opened")
  If fNameAndPath = False Then Exit Sub
  Workbooks.Open Filename:=fNameAndPath


  Application.ScreenUpdating = False

  'Initialize data
  Set ThisSheet = ActiveWorkbook.Worksheets(1)
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 50    '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

  Application.ScreenUpdating = False

  With wb
    .SaveAs Filename:=fNameAndPath & "\File " & WorkbookCounter, FileFormat:=xlCSV
    wb.Close False
    Application.DisplayAlerts = True
 End With

  'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub

脚本的目的是让一个＆＃39;主人＆＃39;文件并拆分成较小的文件，将它们保存为CSV格式。

With wb
    .SaveAs Filename:=fNameAndPath & "\File " & WorkbookCounter, FileFormat:=xlCSV
    wb.Close False
    Application.DisplayAlerts = True
 End With

我尝试做的是创建使用原始文件名保存新创建的文件作为新创建的文件名的一部分，然后关闭所有文件。

有些人可能会对我出错的地方提供一些指导吗？

非常感谢和亲切的问候

克里斯

Answer 1

.SaveAs Filename:=fNameAndPath & "\File " & WorkbookCounter, FileFormat:=xlCSV
'                                ^^^

这看起来像一个无效的名称，因为fNameAndPath已经是Excel文件的路径和名称，类似C:\Folder\something.csv，因此它不能是文件夹。您是否尝试在保存的文件名中添加\？

如果您想要在刚刚打开的csv文件的同一文件夹中创建不同的文件，则可以使用_（下划线或文件名中操作系统可接受的任何其他字符）。所以你可以试试：

.SaveAs Filename:=fNameAndPath & "_File " & WorkbookCounter, FileFormat:=xlCSV
'                                ^^^

修改

在更好地理解您的要求之后，关于您想要实现的文件命名和拆分，我重新考虑了您的代码。

基本上我在将"File x.csv"添加到名称之前删除了文件的扩展名。我还删除了Copy/Paste内容以支持赋值（这应该更快），因为您生成csv因此您不需要任何格式，只需要值。代码中的一些注释进一步限定了该方法。

Sub SplitWorksheet()
  Dim rowsPerFile As Long: rowsPerFile = 50 ' <-- Set to appropriate number

  Dim fNameAndPath
  fNameAndPath = Application.GetOpenFilename(Title:="Select File To split")
  If fNameAndPath = False Then Exit Sub
  Dim wbToSplit As Workbook: Set wbToSplit = Workbooks.Open(Filename:=fNameAndPath)

  Application.ScreenUpdating = False: Application.DisplayAlerts = False
  On Error GoTo Cleanup

  Dim sheetToSplit As Worksheet: Set sheetToSplit = wbToSplit.Worksheets(1)
  Dim numOfColumns As Long: numOfColumns = sheetToSplit.UsedRange.Columns.Count
  Dim wbCounter As Long: wbCounter = 1 ' auto-increment for file names

  Dim rngHeader As Range, rngToCopy As Range, newWb As Workbook, p  As Long
  Set rngHeader = sheetToSplit.Range("A1").Resize(1, numOfColumns) ' header row

  For p = 2 To sheetToSplit.UsedRange.Rows.Count Step rowsPerFile - 1
    ' Get a chunk for each new workbook
    Set rngToCopy = sheetToSplit.Cells(p, 1).Resize(rowsPerFile - 1, numOfColumns)
    Set newWb = Workbooks.Add
    ' copy header and chunk
    newWb.Sheets(1).Range("A1").Resize(1, numOfColumns).Value = rngHeader.Value
    newWb.Sheets(1).Range("A2").Resize(rowsPerFile - 1, numOfColumns).Value = rngToCopy.Value2

    ' Save the new workbook with new name then close it
    ' Remove extension from original name then add "_File x.csv"
    Dim newFileName As String
    newFileName = Left(fNameAndPath, InStrRev(fNameAndPath, ".") - 1)
    newFileName = newFileName & "_File " & wbCounter & ".csv"

    newWb.SaveAs Filename:=newFileName, FileFormat:=xlCSV
    newWb.Close False
    wbCounter = wbCounter + 1
  Next p

Cleanup:
  If Err.Number <> 0 Then MsgBox Err.Description
  If Not wbToSplit Is Nothing Then wbToSplit.Close False
  Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub

Answer 2

将另一个工作簿对象变量声明为

Dim wb1 As Workbook

打开文件时将文件分配给新工作簿变量（ wb1 ） -

Set wb1 = Workbooks.Open(Filename:=fNameAndPath)

With wb
 .SaveAs Filename:=wb1.Path & "\" & Left(wb1.Name, InStr(wb1.Name, ".") - 1) & "_File " & WorkbookCounter, FileFormat:=xlCSV
  wb.Close False
  Application.DisplayAlerts = True
End With

fNameAndPath 字符串无效，因为它包含文件名的文件夹地址

Answer 3

我不能发表评论，但这是A.S.H的帖子的评论的延续。

我看起来你只需要将.csv放在新文件名的中间。您可以使用

执行此操作

fNameAndPath = Left(ThisWorkbook.FullName, (InStrRev(ThisWorkbook.FullName, ".", -1, vbTextCompare) - 1))

这将删除文件扩展名（CSV或其他）。在你的saveas行之前这样做。

保存原件副本时另存为错误

3 个答案: