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

Question

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

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

我的目标是将合并单元格的结果保存到一个新的 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 以匹配您的路径。这也将创建（或使用，如果存在）Range.csv 文件，所以我注释掉了最后的 .SaveAs 行。

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

Save the results of merged cells to a new csv file

excel

export

range

save

cell