有没有办法导出和Excel工作表而不复制到工作簿？

2 回答

• 4

  试试这个（ tested on a simple dataset ）

  Private Sub ExportToCsv()
      Dim ws As Worksheet
      Dim delim As String, LastCol As String, csvFile As String, CsvLine As String
      Dim aCell As Range, DataRange As Range
      Dim ff As Long, lRow As Long, lCol As Long
      Dim i As Long, j As Long
  
      '~~> We use "," as delimiter
      delim = ","
  
      '~~> Change this to specify your file name and path
      csvFile = "C:\Users\Siddharth\Desktop\Sample.Csv"
  
      '~~> Change this to the sheet which you want to export as csv
      Set ws = ThisWorkbook.Sheets("Sheet9")
  
      With ws
          '~~> Find last row and last column
          lRow = .Cells.Find(What:="*", _
                  After:=.Range("A1"), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Row
  
          lCol = .Cells.Find(What:="*", _
                  After:=.Range("A1"), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByColumns, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Column
  
          '~~> Column number to column letter
          LastCol = Split(Cells(, lCol).Address, "$")(1)
  
          '~~> This is the range which will be exported
          Set DataRange = .Range("A1:" & LastCol & lCol)
  
          '
          '~~> Loop through cells in the range and write to text file
          '
  
          ff = FreeFile
  
          Open csvFile For Output As #ff
  
          For i = 1 To lRow
              For j = 1 To lCol
                  CsvLine = CsvLine & (delim & Replace(.Cells(i, j).Value, """", """"""""))
              Next j
  
              Print #ff, Mid(CsvLine, 2)
  
              CsvLine = ""
          Next
  
          '~~> Close text file
          Close #ff
      End With
  End Sub
  

  回复于 2024-05-09T11:00:18+08:00
• 0

  Sub CopyToCSV()
  
          Dim FlSv As Variant
          Dim MyFile As String
          Dim sh As Worksheet
          Dim MyFileName As String
          Dim strTxt As String
  
          Dim vDB, vR() As String, vTxt()
          Dim i As Long, n As Long, j As Integer
          Dim objStream
          Dim strFile As String
  
  Application.ScreenUpdating = False
  
          DateString = Format(Now(), "dd-mm-yyyy_hh-mm-ss-AM/PM") '<~~ uses current time from computer clock down to the second
          MyFileName = "Results - " & DateString
  
          FlSv = Application.GetSaveAsFilename(MyFileName, fileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Where should we save this?")
  
       If FlSv = False Then GoTo UserCancel Else GoTo UserOK
  
  UserCancel:             '<~~ this code is run if the user cancels out the file save dialog
          ActiveWorkbook.Close (False)
          MsgBox "Export Canceled"
          Exit Sub
  
  UserOK:                 '<~~ this code is run if user proceeds with saving the file (clicks the OK button)
  
      Set objStream = CreateObject("ADODB.Stream")
      MyFile = FlSv
      vDB = ActiveSheet.UsedRange
      For i = 1 To UBound(vDB, 1)
          n = n + 1
          ReDim vR(1 To UBound(vDB, 2))
          For j = 1 To UBound(vDB, 2)
              vR(j) = vDB(i, j)
          Next j
          ReDim Preserve vTxt(1 To n)
          vTxt(n) = Join(vR, ",")
      Next i
      strtxt = Join(vTxt, vbCrLf)
      With objStream
          .Charset = "utf-8"
          .Open
          .WriteText strtxt
          .SaveToFile FlSv, 2
          .Close
      End With
      Set objStream = Nothing
  
          Application.DisplayAlerts = True
          Application.ScreenUpdating = True
  
  End Sub
  

  回复于 2024-05-09T11:00:18+08:00