VBA 将 Excel 的选定行值导出到 csv

Question

我对 VBA 有要求，其中，如果我在 Excel 中选择一个单元格，它将将该整行值导出到 csv。

我已经尝试过了

Sub WriteCSVFile()

Dim My_filenumber As Integer
Dim logSTR As String

My_filenumber = FreeFile

logSTR = logSTR & Cells(1, "A").Value & " , "
logSTR = logSTR & Cells(2, "A").Value & " , "
logSTR = logSTR & Cells(3, "A").Value & " , "
logSTR = logSTR & Cells(4, "A").Value

Open "C:\Users\xxxxx\Desktop\Sample.csv" For Append As #My_filenumber
    Print #My_filenumber, logSTR
Close #My_filenumber

End Sub

如果可以动态选择范围，就可以解决目的。

Answer 1

将选择行导出到 CSV

Sub ExportRowsToCSV()

    Const FILE_PATH_RIGHT As String = "\Desktop\Sample.csv"
    Const FIRST_CELL_ADDRESS As String = "A2"
    Const ColDelimiter As String = "," ' or ";"
    Const RowDelimiter As String = vbLf
    
    If ActiveSheet Is Nothing Then Exit Sub ' no visible workbook open
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub ' not a worksheet
    If Not TypeOf Selection Is Range Then Exit Sub ' not a range selected
    
    Dim FilePath As String
    FilePath = Environ("USERPROFILE") & FILE_PATH_RIGHT
    ' or:
    'FilePath = Environ("OneDrive") & FILE_PATH_RIGHT
    
    Dim drg As Range: Set drg = Selection
    Dim ws As Worksheet: Set ws = drg.Worksheet
    
    Dim srg As Range
    With ws.UsedRange
        Dim lCell As Range: Set lCell = .Cells(.Rows.Count, .Columns.Count)
        Set srg = ws.Range(FIRST_CELL_ADDRESS, lCell)
    End With
    
    Dim rg As Range: Set rg = Intersect(srg, drg)
    If rg Is Nothing Then Exit Sub
    Set rg = Intersect(srg, rg.EntireRow)
    If rg Is Nothing Then Exit Sub
    
    Dim dLen As Long: dLen = Len(ColDelimiter)
    
    Dim rString As String
    
    Dim rrg As Range
    Dim cell As Range
    
    For Each rrg In rg.Rows
        For Each cell In rrg.Cells
            rString = rString & CStr(cell.Value) & ColDelimiter
        Next cell
        rString = Left(rString, Len(rString) - dLen) & RowDelimiter
    Next rrg
    rString = Left(rString, Len(rString) - Len(RowDelimiter))
    
    Dim TextFile As Long: TextFile = FreeFile
    
    Open FilePath For Append As #TextFile
        Print #TextFile, rString
    Close #TextFile

    MsgBox "Row(s) exported.", vbInformation

End Sub

Answer 2

这里我得到了复制“单元格处于活动状态的整行中的值”并粘贴到 csv 文件的代码。

'''

Sub xlRangeToCSVFile() 
Dim myWB As Workbook 
Dim rngToSave As Range 
Dim fNum As Integer 
Dim csvVal As String 
Dim i As Integer 
Set myWB = ThisWorkbook
csvVal = ""
fNum = FreeFile
Set rngToSave = Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row)
Open "C:\Users\xxxxx\Desktop\Sample.csv" For Output As #fNum
i = 1
For j = 1 To rngToSave.Columns.Count
csvVal = csvVal & Chr(34) & rngToSave(i, j).Value & Chr(34) & ","
Next
Print #fNum, Left(csvVal, Len(csvVal) - 1)
csvVal = ""
Close #fnum
End Sub

'''