作者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/m.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