作者Kamikiri (☒☒)
看板Office
标题[算表] 计算单格多行每行的字数 VBA卡关
时间Mon Sep 16 17:59:50 2019
软体:OFFICE 365 EXCEL
版本:1908
最近因为工作关系
需要写一个可以计算单格多行每行字数各自是多少的VBA
我是用资料剖析先把每格的文字以CHAR(10)当分隔先做切割
切割後会自动列在C5到AG5共30格（最多分割30行）
计算行数的公式是放在C栏
=LEN(A3)-LEN(SUBSTITUTE(A3,CHAR(10),""""))+1
版面配置如图
https://i.imgur.com/gzQvRhg.png
VBA公式如下
资料剖析分割单格内各行文字放入D5～AG5(上略)
Dim i, p, a As Integer
For p = 5 To 100 '设定计算栏为5～100
a = Cells(p, 3).Value '将C5～C100的值=行数设为变数
For i = 4 To (a + 3) '设定计算列为D到～(行数的值+3=输出栏)
这条为了避免行数不到30时输出一堆0，把范围控制在来源行数内
If Len(Cells(p, 1)) > 0 Then '若A栏字数大於0
Cells(3, 3).Copy Destination:=Cells(p, 3) '复制计算行数公式到C栏
Cells(p, i).Value = Len(Cells(p, i)) '计算D5~AG5分割後的字数
Else
End If
Next '回圈p+1
Next '回圈i+1
Cells(5, 2).Formula = "=TEXTJOIN(CHAR(10), TRUE,D5:AG5) '输出结果到B5
复制公式到其他格(下略)
写到这样已经快完成了，但是却严重卡关
目前遇到的问题是Cells(3, 3).Copy Destination:=Cells(p, 3)没办法正常运作
除非C栏本来就有值，不然IF後的运算式会完全被略过
但是把这条移出IF後单独运作都是正常的
所以不太懂到底问题出在哪里
希望有人可以帮忙解答一下
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 60.248.94.55 (台湾)
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/Office/M.1568627994.A.BD5.html
1F：→ soyoso: 因为c5:c100为空白储存格的话，变数a写入为0 09/16 18:26
2F：→ soyoso: (a+3)=3，这个回圈非反序的话，初始值(4)需大於终止值(3) 09/16 18:26
3F：→ soyoso: 因此c5:c100要以内文写到的公式来回传储存格内的char(10) 09/16 18:26
4F：→ soyoso: 换行的个数 09/16 18:26
5F：→ soyoso: range.copy复制公式的那行动作移到a=cells(p,3).value上方 09/16 18:30
6F：→ soyoso: 修正一下回文需大於方面，应是需大於"等於" 09/16 19:09
7F：→ Kamikiri: 所以变数设立的当下就会直接取值了吗？ 09/16 22:03
8F：→ soyoso: 变数设立？是指什麽？宣告dim或是a=range.value 09/16 22:05
9F：→ Kamikiri: 我还以为是开始运算後才依序进行 09/16 22:05
10F：→ Kamikiri: 因为IF後是先用到p才轮到i 我以为用到i时才会取a 09/16 22:07
11F：→ Kamikiri: 如果是宣告当下就会直接提取的话 我就懂了 感谢 09/16 22:08
12F：→ soyoso: 於a=range.value时就会将所指定储存格的值，写入变数a内 09/16 22:10
13F：→ soyoso: 内文巨集宣告dim时并没有写入，是执行到上述回文动作时才 09/16 22:12
14F：→ soyoso: 写入到变数a内 09/16 22:12
後续改良成这样後可以正常运作了，只会抓有值的栏位，
虽然还能再改良，但暂时以能用优先，感谢
Dim i, p, a, x As Integer
For p = 5 To 100
If Len(Cells(p, 1)) > 0 Then
Cells(3, 3).Copy Destination:=Cells(p, 3)
a = Cells(p, 3).Value
Else
End If
For i = 4 To (a + 3)
If Len(Cells(p, 1)) > 0 Then
Cells(p, i).Value = Len(Cells(p, i))
Else
End If
x = a + 3
If Len(Cells(p, 1)) > 0 Then
Cells(p, 2).Formula = "=TEXTJOIN(CHAR(10), TRUE,D" & p & ":AG" & p & ")"
Else
End If
Next
Next
※ 编辑: Kamikiri (123.193.189.222 台湾), 09/16/2019 23:03:18
※ 编辑: Kamikiri (123.193.189.222 台湾), 09/16/2019 23:05:55