excel表单元格内的文字下划线可以批量改为（）吗？

彭伟1986 · 发表于 2024-4-2 09:40

本帖最后由彭伟1986 于 2024-4-2 10:18 编辑

图中文字下划线

把图中文字下划线改为

改为文字加括号

LIUZHU · 发表于 2024-4-2 10:00

附件都没有，你要别人怎么处理？

彭伟1986 · 发表于 2024-4-2 10:19

LIUZHU 发表于 2024-4-2 10:00
附件都没有，你要别人怎么处理？

附件已经上传

lisongmei · 发表于 2024-4-2 10:27

Sub test()
Dim len1
Dim arr(1 To 100)
Dim num%, min1%, max1%, i%, x%
x = Cells(Cells.Rows.Count, 1).End(xlUp).row
For row = 1 To x
With Range("a" & row)
      For i = 1 To Len(.Value)
         If .Characters(i, 1).Font.Underline = xlUnderlineStyleSingle Then
            num = num + 1
            arr(num) = i
         End If
      Next
      min1 = Application.Min(arr)
      max1 = Application.Max(arr)
      If max1 - min1 + 1 > 1 Then
         .Characters(min1, max1 - min1 + 1).Text = "（" & .Characters(min1, max1 - min1 + 1).Text & "）"
         .Characters.Font.Underline = xlUnderlineStyleNone
      End If
End With
Next
End Sub

ykcbf1100 · 发表于 2024-4-2 10:35

附件供参考。。。

ykcbf1100 · 发表于 2024-4-2 10:35

参与一下。。。。

Sub 下划线文字转换() '//2024.4.2
With Sheets("Sheet1")
For Each cell In .UsedRange
r1 = 1: r2 = 1
st = ""
Do While r1 <= Len(cell.Value)
If cell.Characters(r1, 1).Font.Underline = xlUnderlineStyleSingle Then
r2 = r1
st = st & "(" & Mid(cell.Value, r1, 1)
Do While cell.Characters(r2 + 1, 1).Font.Underline = xlUnderlineStyleSingle
r2 = r2 + 1
st = st & Mid(cell.Value, r2, 1)
Loop
st = st & ")"
r1 = r2 + 1
Else
st = st & Mid(cell.Value, r1, 1)
r1 = r1 + 1
End If
Loop
cell.Value = st
cell.Font.Underline = False
Next cell
End With
End Sub

复制代码

ykcbf1100 · 发表于 2024-4-2 10:51

本帖最后由 ykcbf1100 于 2024-4-2 10:58 编辑

lisongmei 发表于 2024-4-2 10:27
Sub test()
Dim len1
Dim arr(1 To 100)

得再加一句代码结果才对：num=0

Sub test()
Dim arr(1 To 1000)
r = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For i = 1 To r
With Cells(i, 1)
s = .Value
m = 0
For x = 1 To Len(s)
If .Characters(x, 1).Font.Underline = xlUnderlineStyleSingle Then
m = m + 1
arr(m) = x
End If
Next
min1 = Application.Min(arr)
max1 = Application.Max(arr)
If m >= 0 Then
l = max1 - min1 + 1
.Characters(min1, l).Text = "（" & .Characters(min1, l).Text & "）"
.Characters.Font.Underline = xlUnderlineStyleNone
End If
End With
Next
End Sub

复制代码

LIUZHU · 发表于 2024-4-2 11:19

JSA代码

function test(){
let arr=Range("a1").CurrentRegion.Value2;
let res=arr.map(([x],i)=>{
let s="";
for (let j=1;j<=x.length;j++){
if (Range(`a${i+1}`).Characters(j,1).Font.Underline==2){
s+=x[j-1];
}else{
if (s!=""){
arr[i][0]=arr[i][0].replace(s,`（${s}）`); //替换
s=""; //初始化
}
}
}
return arr[i]
});
Range("c1").Resize(res.length,res[0].length).Value2=res;
}

复制代码

LIUZHU · 发表于 2024-4-2 11:20

附件在此，WPS测试

lisongmei · 发表于 2024-4-2 11:22

ykcbf1100 发表于 2024-4-2 10:51
得再加一句代码结果才对：num=0

是的呢，当时传完就发现了有瑕疵，但是在审核中，就没管他，谢谢指正哈

		自动登录	找回密码
密码			免费注册

[求助] excel表单元格内的文字下划线可以批量改为（）吗？

评分