excel - 选择表格上的行和列

Question

我正在使用这个脚本：

' Loop for each row in selection.
For RowCount = 1 To Selection.Rows.Count

' Loop for each column in selection.
  For ColumnCount = 1 To Selection.Columns.Count

    ' Write current cell's text to file with quotation marks.
     Print #FileNum, """" & Selection.Cells(RowCount, _
        ColumnCount).Text & """";

     ' Check if cell is in last column.
     If ColumnCount = Selection.Columns.Count Then
        ' If so, then write a blank line.
        Print #FileNum,
     Else
        ' Otherwise, write a comma.
        Print #FileNum, ";";
     End If
  ' Start next iteration of ColumnCount loop.
  Next ColumnCount
' Start next iteration of RowCount loop.
Next RowCount

我尝试只选择范围 A1:E57

For RowCount = 1 To Range("A1:E57").EntireRow.Select

目的是，我导出此范围的修复选择。

我忘了添加什么

标签： excelvba

Answer 1

范围到字符串专长ArrayList

Option Explicit

Sub testRangeToString()
    
    Const FileName As String = "F:\Test\2021\Test.csv"
    Const rgAddr As String = "A1:E57"
    Const cDel As String = ";"
    Const rDel As String = vbLf
    Const wStr As String = """"
    
    Dim rg As Range: Set rg = Range("A1:E57")
    Dim Result As String: Result = RangeToString(rg, cDel, rDel, wStr)
    
    Dim TextFile As Long: TextFile = FreeFile
    On Error GoTo clearError
    Open FileName For Output As #TextFile
    Print #TextFile, Result

SafeExit:
    Close #TextFile
    Exit Sub

clearError:
    Select Case Err.Number
    Case 76
        Debug.Print "Cannot create the file (" & Err.Description & ")."
    Case 70
        Debug.Print "The file is open (" & Err.Description & ")."
    Case Else
        Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    End Select
    Resume SafeExit

End Sub

Function RangeToString( _
    rg As Range, _
    Optional ByVal ColumnDelimiter As String = ",", _
    Optional ByVal RowDelimiter As String = vbLf, _
    Optional ByVal WrapString As String = "") _
As String
    Dim Data As Variant: Data = rg.Value
    Dim rCount As Long: rCount = UBound(Data, 1)
    Dim cCount As Long: cCount = UBound(Data, 2)
    Dim r As Long, c As Long
    Dim alr As Object: Set alr = CreateObject("System.Collections.ArrayList")
    Dim alc As Object: Set alc = CreateObject("System.Collections.ArrayList")
    For r = 1 To rCount
        alc.Clear
        For c = 1 To cCount
            alc.Add WrapString & Data(r, c) & WrapString
        Next c
        alr.Add Join(alc.ToArray, ColumnDelimiter)
    Next r
    RangeToString = Join(alr.ToArray, RowDelimiter)
End Function