Question

我正在尝试编写一个宏来将Excel导出为CSV，但我在vba中是一个非常新的东西。我现在拥有的是：

Option Explicit

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteFormats
    End With        

    Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub

来自Excel: macro to export worksheet as CSV file without leaving my current Excel sheet

哪个是正确的csv但是我试图摆脱额外的＆＃34 ;;＆＃34;在行的末尾。请问有办法吗？

示例：

1|2|3|4|5
2|5|3
2| |5
3

出口将给出：

1;2;3;4;5
2;5;3;;
2;;5;;
3;;;;

我想要的是：

1;2;3;4;5
2;5;3
2;;5
3

这可能吗？

非常感谢你的帮助

编辑：这是在给出答案后编辑的代码：

Option Explicit
Public Function RemoveTrailing(s As String) As String
  Dim nIndex As Integer

  For nIndex = Len(s) To 1 Step -1
    If Right$(s, 1) = ";" Then
      s = Left$(s, Len(s) - 1)
    End If
  Next
  RemoveTrailing = s

End Function

Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    'Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Dim sFile2 As String
      Dim sLine As String

      sFile2 = Replace(MyFileName, ".csv", "2.csv")
      Open MyFileName For Input As #1
      Open sFile2 For Output As #2

      Do Until EOF(1)
        Line Input #1, sLine
        Print #2, RemoveTrailing(sLine)
      Loop

      Close #1
      Close #2
End Sub

但我收到错误＆＃34;类型不兼容＆＃34;

Answer 1

这是一个删除尾部半冒号的函数：

Public Function RemoveTrailing(s As String) As String
  Dim nIndex As Integer

  For nIndex = Len(s) To 1 Step -1
    If Right$(s, 1) = ";" Then
      s = Left$(s, Len(s) - 1)
    End If
  Next
  RemoveTrailing = s

End Function

这是一个更短的代码片段，可以做同样的事情：

Public Function RemoveTrailing2(s As String) As String
  Do Until Right$(s, 1) <> ";"
    s = Left$(s, Len(s) - 1)
  Loop
  RemoveTrailing2 = s
End Function

以下是使用上述功能的方法。基本上它的作用是逐行读取CSV文件，并将每一行输出到一个删除;个字符的新文件。将其添加到例程的最后：

  Dim sFile2 As String
  Dim sLine As String

  sFile2 = Replace(MyFilename, ".csv", "2.csv")
  Open MyFilename For Input As #1
  Open sFile2 For Output As #2

  Do Until EOF(1)
    Line Input #1, sLine
    Print #2, RemoveTrailing(sLine)
  Loop

  Close #1
  Close #2

新文件将具有相同的文件名，文件名末尾带有2。

将Excel导出到csv并删除行的最后一个空单元格

1 个答案: