Excel·VBA选中区域保存为txt文本

vba代码有3种写法，都可实现，适用单/多列选中、单/多列部分选中，选中区域内容保存为一个txt文件

Private Function RE_STR(source_str As String, pat As String, Optional replace_str As String = "$1")
    '通用正则替换函数，函数定义RE(字符串，正则模式，替换值)对单元格返回正则替换后的字符串
    With CreateObject("vbscript.regexp")  '正则表达式
        .Global = True
        .Pattern = pat
        RE_STR = .Replace(source_str, replace_str)
    End With
End Function

Sub 选中区域保存为txt()
    '适用单/多列选中、单/多列部分选中，选中区域内容保存为一个txt文件
    Dim rng As Range, arr, title_row, file_name, save_file, i, temp, ss
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算
    arr = rng.Value  '转为数组
'--------------------参数填写：title_row，数字
    title_row = 1    '表头行数，不写入txt；如果为0，则表示选中内容全部写入txt
    'file_name = "输出文件"  '输出文件名
    file_name = Join(Application.index(arr, 1), "")  '第1行为文件名
    file_name = RE_STR(CStr(file_name), "[\/:*?""<>|]", "")  '删除文件名非法字符
    save_file = ActiveWorkbook.Path & "\" & file_name & ".txt"  '保存路径，或ThisWorkbook.Path

    For i = LBound(arr) + title_row To UBound(arr)    '遍历数组
        temp = Join(Application.index(arr, i), vbTab) '行内数据分隔，制表符
        ss = ss & temp & vbCrLf  '换行
    Next
    Open save_file For Output As #1  '写入txt文件
    Print #1, ss  'print字符串，write带格式（日期时间前后#）
    Close #1
    
'--------------------for...next写法，1行表头为文件名
'    Dim rng As Range, first_row, last_row, first_col, last_col, i, j, ss
'    Set rng = Intersect(ActiveSheet.UsedRange, Selection)
'    save_file = ActiveWorkbook.Path & "\" & file_name & ".txt"  '保存路径
'    first_row = rng.Row     '选中区域开始行号
'    last_row = first_row + rng.Rows.count - 1  '选中区域结束行号
'    first_col = rng.column  '选中区域开始列号
'    last_col = first_col + rng.Columns.count - 1  '选中区域结束列号
'
'    For i = first_row To last_row
'        n = n + 1
'        For j = first_col To last_col
'            If n = 1 Then
'                file_name = file_name & Cells(i, j).Text
'            Else
'                ss = ss & Cells(i, j).Text & vbTab
'            End If
'        Next
'        ss = ss & vbCrLf  '首行为空
'    Next
'    file_name = RE_STR(CStr(file_name), "[\/:*?""<>|]", "")  '删除文件名非法字符
'    save_file = ActiveWorkbook.Path & "\" & file_name & ".txt"  '保存路径
'    Open save_file For Output As #1
'    Print #1, ss
'    Close #1
    
'--------------------for...each写法，1行表头为文件名
'    Dim rng As Range, r, c, n, file_name, save_file, ss
'    Set rng = Intersect(ActiveSheet.UsedRange, Selection)
'
'    For Each r In rng.Rows
'        n = n + 1
'        If n = 1 Then
'            For Each c In r.Cells
'                file_name = file_name & c.Text
'            Next
'        Else
'            For Each c In r.Cells
'                ss = ss & c.Text & vbTab
'            Next
'            ss = ss & vbCrLf
'        End If
'    Next
'    file_name = RE_STR(CStr(file_name), "[\/:*?""<>|]", "")  '删除文件名非法字符
'    save_file = ActiveWorkbook.Path & "\" & file_name & ".txt"  '保存路径
'    Open save_file For Output As #1
'    Print #1, ss
'    Close #1
    
End Sub

举例

选中A-E列，运行代码，生成txt文件