如何遍历整个Excel文件？相关VBA代码实现技术咨询

Hey there! Let's work through your code to fix existing issues and add the missing logic to write your Excel data into an RTF file. Here's a breakdown of what needs adjusting, plus the fully functional code:

Key Issues in Your Original Code #

• Syntax Error: The FileFilter argument in GetSaveAsFilename was missing an equals sign (:= instead of just :).
• Data Type Limitation: Line was declared as Integer, which can only handle up to 32767 rows—Excel supports far more, so we’ll use Long instead.
• Missing Cancel Handling: If the user clicks "Cancel" in the save dialog, Zieldatei will return False, which would cause an error when trying to open the file. We need to handle this gracefully.
• Unclosed File: You didn’t include Close #1 to properly close the RTF file after writing, which could leave the file locked.
• Incomplete Loop: The core logic to read each row’s data and write it to the file was missing.

Corrected and Completed Code #

Sub Rechteck1_KlickenSieAuf()
    Dim Zieldatei As Variant ' Use Variant to handle cancel case
    Dim currentRow As Long ' Use Long for support of large row counts
    Dim lastCol As Integer
    Dim outputLine As String
    
    ' Optional: Protect the worksheet (adjust password if needed)
    ' ThisWorkbook.Worksheets(1).Protect Password:="yourSecurePassword"
    
    ' Prompt user to select save location, handle cancel
    Zieldatei = Application.GetSaveAsFilename( _
        FileFilter:="AVL (*.rtf), *.rtf", _
        InitialFileName:="AVL.rtf")
    
    If Zieldatei = False Then
        MsgBox "Save operation cancelled."
        Exit Sub
    End If
    
    ' Set up error handling to ensure file closes even if something goes wrong
    On Error GoTo Cleanup
    Open Zieldatei For Output As #1
    
    With ThisWorkbook.Worksheets(1)
        ' Loop through every row from 1 to the last used row in column A
        For currentRow = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            outputLine = ""
            ' Find the last used column in the current row
            lastCol = .Cells(currentRow, .Columns.Count).End(xlToLeft).Column
            
            ' Build a string with all cells in the row, separated by tabs
            For Each cell In .Range(.Cells(currentRow, 1), .Cells(currentRow, lastCol))
                outputLine = outputLine & cell.Value & vbTab
            Next cell
            
            ' Remove the trailing tab and write the line to the RTF file
            outputLine = Left(outputLine, Len(outputLine) - Len(vbTab))
            Print #1, outputLine
        Next currentRow
    End With
    
    MsgBox "Data successfully saved to " & Zieldatei, vbInformation
    
Cleanup:
    ' Always close the file to avoid locking it
    Close #1
    ' Show error message if something went wrong
    If Err.Number <> 0 Then
        MsgBox "Error occurred: " & Err.Description, vbCritical
    End If
    
    ' Optional: Unprotect the worksheet if you protected it earlier
    ' ThisWorkbook.Worksheets(1).Unprotect Password:="yourSecurePassword"
End Sub

Key Customization Tips #

• Delimiter: Change vbTab to ", " for comma-separated values, or any other separator you need.
• RTF Formatting: If you want formatted RTF (like tables, bold text), you’ll need to add RTF markup. For example, to start a basic table:

  Print #1, "{rtf1\ansi\deff0{\fonttbl{\f0 Calibri;}}}"
  Print #1, "\trowd\trgaph100"
  

  Then wrap each cell in \cellx tags. For plain-text RTF, the code above works perfectly.

内容的提问来源于stack exchange，提问作者Marius