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文件