将合并的单元格的结果保存到一个新的csv文件

我提出了关于每行单元格合并的问题。 我在这里收到了很好的答案： 第一个问题

现在，我正在使用第一个问题中的代码，另外我使用了这个问题的代码： 第二个问题

我的目标是将合并的单元格的结果保存到一个新的csv文件。

结合两者的代码我有这样的：

Sub sisk() Dim sisk As String Dim row As Long Dim col As Long Dim Rng As Range Dim WorkRng As Range Dim xFile As Variant Dim xFileString As String For row = 2 To 96 sisk = vbNullString For col = 1 To 4 If VBA.Len(sisk) Then sisk = sisk & "," sisk = sisk & Cells(row, col) Next col Worksheets("Sheet1").Cells(row, 7) = sisk Next row xTitleId = "Please select range to be exported" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) Application.ActiveSheet.Copy Application.ActiveSheet.Cells.Clear WorkRng.Copy Application.ActiveSheet.Range("A1") Set xFile = CreateObject("Scripting.FileSystemObject") ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False End Sub 

而不是做这一切，我怎样才能调整代码？ 我只需要将合并的单元格的结果导出到一个新的.csv文件。 而不是这样做：

  Worksheets("Sheet1").Cells(row, 6) = sisk 

我想将结果（sisk）自动保存在新的CSV文件中。

Answer 1

这个怎么样：

 Sub sisk() Dim sisk As String, xFileString As String, xTitleId As String, pathName As String Dim row As Long, col As Long Dim Rng As Range, WorkRng As Range Dim xFile As Variant Dim my_File As Integer 'pathName = Application.ActiveWorkbook.Path pathName = "C:\Users\[USER NAME]\Desktop" my_File = FreeFile Open pathName & "\Range.csv" For Output Lock Write As #my_File ' Use the next line for headers, if wanted Print #my_File, "Header1" & "," & "Header2" For row = 2 To 96 sisk = vbNullString For col = 1 To 4 If VBA.Len(sisk) Then sisk = sisk & "," sisk = sisk & Cells(row, col) Next col Worksheets("Sheet1").Cells(row, 7) = sisk Print #my_File, sisk Next row xTitleId = "Please select range to be exported" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) Application.ActiveSheet.Copy Application.ActiveSheet.Cells.Clear WorkRng.Copy Application.ActiveSheet.Range("A1") 'Set xFile = CreateObject("Scripting.FileSystemObject") 'ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False Close my_File End Sub 

我不确定他们是否粘贴在你想要的位置，但是让我知道该怎么调整，我可以！

一定要更改pathName以匹配您的path。 这也将创build（或使用，如果存在） Range.csv文件，所以我注释了最后的.SaveAs行。