[已解决]求V语句判断内容，自动换行

xuflower · 发表于 2013-5-27 13:38

根据单元格中数据，求一个V代码，根据内容设置数据自动换行，并调整单元格行高与设置单元格格式，，，在线等，希望大家帮我想想办法，如果V太麻烦函数也可以。。。。。由于我的数据在变化，而且具体应用时，单元格也不固定，所以想求个V代码。。在线等，~~~~~~

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-27 15:29

Sub 整理()
'正则对象
Dim objRegExp As Object
Dim objItem As Object
'字符串，存储整理好的数据
Dim str$
'循环用
Dim i As Long, arr
'正则对象
Set objRegExp = CreateObject("VBScript.regExp")
'源数据
arr = Range("a1:i1")
With objRegExp
'全局匹配
.Global = True
'匹配规则
.Pattern = "(合计:)|(.+?笔)(.+?元)?\，?"
'数组内元素循环
For i = 1 To UBound(arr, 2)
'字符串清空
str = ""
'测试数组元素是否符合规则
If .test(arr(1, i)) Then
'执行规则匹配，然后遍历对象
For Each objItem In .Execute(arr(1, i))
'每一行数据后面添加回车换行符
str = str & objItem.Value & vbCrLf
Next
'生成的字符串写回数组
arr(1, i) = str
End If
Next
End With
'数组再写回单元格
Range("a8").Resize(UBound(arr), UBound(arr, 2)).Value = arr
'行高自适应
Rows(8).EntireRow.AutoFit
'释放对象引用
Set objRegExp = Nothing
End Sub

复制代码

跳转到最佳答案楼层

lyf7276 · 发表于 2013-5-27 14:13

感觉你这用正则表达式最好

xuflower · 发表于 2013-5-27 14:18

lyf7276 发表于 2013-5-27 14:13
感觉你这用正则表达式最好

不明白意思，能否指点一二

1032446692 · 发表于 2013-5-27 14:30

Sub test()
Dim st
st = Cells(1, 1)
st = Replace(Replace(st, "合计:", "合计:" & Chr(10), 1), "笔", "笔" & Chr(10), 1)
Cells(8, 1) = st

st = Cells(1, 4)
st = Replace(st, "万元", "万元" & Chr(10), 1)
Cells(8, 4) = st

st = Cells(1, 9)
st = Replace(Replace(st, "利率:", "利率:" & Chr(10), 1), "笔?", "笔?" & Chr(10), 1)
Cells(8, 9) = st
Rows("8:8").EntireRow.AutoFit
End Sub

可以这样直接用replace替换

hwc2ycy · 发表于 2013-5-27 14:41

数据录入规范点，另外尽用合并单元格。

hwc2ycy · 发表于 2013-5-27 14:43

正则是可以把数据分离出来。
正则表达式的规则："(合计:)|(.+?笔)(.+?元)?\，?"

hwc2ycy · 发表于 2013-5-27 14:48

Sub 整理()
Dim objRegExp As Object
Dim i As Long, arr
Dim objItem As Object
Set objRegExp = CreateObject("VBScript.regExp")
arr = Range("a1:i1")
Dim str$
With objRegExp
.Global = True
.Pattern = "(合计:)|(.+?笔)(.+?元)?\，?"
For i = 1 To UBound(arr, 2)
str = ""
If .test(arr(1, i)) Then
For Each objItem In .Execute(arr(1, i))
str = str & objItem.Value & vbCrLf
Next
arr(1, i) = str
End If
Next
End With
Range("a8").Resize(UBound(arr), UBound(arr, 2)).Value = arr
Rows(8).EntireRow.AutoFit
Set objRegExp = Nothing
End Sub

复制代码

xuflower · 发表于 2013-5-27 15:22

hwc2ycy 发表于 2013-5-27 14:48

谢了，我先测试一下，有个请求能给代码做下标注吗？

hwc2ycy · 发表于 2013-5-27 15:29

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Sub 整理()
'正则对象
Dim objRegExp As Object
Dim objItem As Object
'字符串，存储整理好的数据
Dim str$
'循环用
Dim i As Long, arr
'正则对象
Set objRegExp = CreateObject("VBScript.regExp")
'源数据
arr = Range("a1:i1")
With objRegExp
'全局匹配
.Global = True
'匹配规则
.Pattern = "(合计:)|(.+?笔)(.+?元)?\，?"
'数组内元素循环
For i = 1 To UBound(arr, 2)
'字符串清空
str = ""
'测试数组元素是否符合规则
If .test(arr(1, i)) Then
'执行规则匹配，然后遍历对象
For Each objItem In .Execute(arr(1, i))
'每一行数据后面添加回车换行符
str = str & objItem.Value & vbCrLf
Next
'生成的字符串写回数组
arr(1, i) = str
End If
Next
End With
'数组再写回单元格
Range("a8").Resize(UBound(arr), UBound(arr, 2)).Value = arr
'行高自适应
Rows(8).EntireRow.AutoFit
'释放对象引用
Set objRegExp = Nothing
End Sub

复制代码

xuflower · 发表于 2013-5-27 15:47

hwc2ycy 发表于 2013-5-27 15:29

看了标注的代码，理解上还是有点问题，还代下一步理解理解，多谢了，测试了没问题，如果有什么理解的问题还要麻烦你一下，先学习一下，多谢

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