|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 盘尼西林99 于 2018-7-12 15:00 编辑
适用范围:工作表头比较复杂且不允许更改者
一般情况,推荐使用Excce自带的“分列”等功能
Option Explicit
Sub 将某列指定区域设置成文本格式()
Rem 2018年7月12日完成
MsgBox "为防止误操作,请务必做好规划!" & vbCrLf & vbCrLf & "咨询电话:139 **** 9780", , "文本格式设置"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Rem 选择工作簿
Dim wb
wb = Application.GetOpenFilename("Excel 文件 ,*.xls*;*.xlsx")
If wb = False Then MsgBox "未选择文件!": Exit Sub
Workbooks.Open (wb)
Rem 输入需查找的工作表名
Dim sh As String
100:
sh = InputBox("请输入要查找的工作表名:", "输入提示", "Sheet2")
On Error Resume Next
If Sheets(sh) Is Nothing Then MsgBox "未输入表名或工作表不存在!", vbOKOnly: GoTo 100
Sheets(sh).Select
Rem 输入起始行号
Dim sr
On Error Resume Next
200:
sr = Val(InputBox("请输入起始行号", "输入提示", 2))
If Not (sr > 0 And sr = Int(sr)) Then
MsgBox "你没有输入行号或输入的不是正整数,请重新输入!", 64 + 1, "温馨提示"
GoTo 200
End If
Rem 输入需转换内容的列号
Dim sc
On Error Resume Next
300:
sc = Val(InputBox("请输入转换列号", "输入提示", 2))
If Not (sc > 0 And sc = Int(sc)) Then
MsgBox "你没有输入列号或输入的不是正整数,请重新输入!", 64 + 1, "温馨提示"
GoTo 300
End If
Rem 为提高速度,利用数组,在指定列指定行以下添加“'”号,使其变成文本格式
Dim arr
Dim j
arr = Range(Cells(sr, sc), Cells(Cells(Rows.Count, sc).End(3).Row, sc)) '相当于arr =Range("A2:A" & i)
For j = 1 To UBound(arr)
arr(j, 1) = "'" & arr(j, 1) '加上一个“'”,使其变成文本格式
Next
Cells(sr, sc).Resize(UBound(arr), 1) = arr
ActiveWorkbook.Close SaveChanges:=True ' 如果要避免出现提示,可添加“SaveChanges”参数,直接保存并关闭工作簿
MsgBox "完工!请查验!", 64, "友情提示"
Application.ScreenUpdating = True '恢复屏幕刷新
Application.DisplayAlerts = True '恢复显示系统警告和消息
ThisWorkbook.Saved = True
Application.Quit
End Sub
|
评分
-
1
查看全部评分
-
|