[算表] 計算單格多行每行的字數 VBA卡關

看板Office作者 (☒☒)時間4年前 (2019/09/16 17:59), 4年前編輯推噓0(0014)
留言14則, 2人參與, 4年前最新討論串1/1
軟體: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://www.ptt.cc/bbs/Office/M.1568627994.A.BD5.html

09/16 18:26, 4年前 , 1F
因為c5:c100為空白儲存格的話,變數a寫入為0
09/16 18:26, 1F

09/16 18:26, 4年前 , 2F
(a+3)=3,這個迴圈非反序的話,初始值(4)需大於終止值(3)
09/16 18:26, 2F

09/16 18:26, 4年前 , 3F
因此c5:c100要以內文寫到的公式來回傳儲存格內的char(10)
09/16 18:26, 3F

09/16 18:26, 4年前 , 4F
換行的個數
09/16 18:26, 4F

09/16 18:30, 4年前 , 5F
range.copy複製公式的那行動作移到a=cells(p,3).value上方
09/16 18:30, 5F

09/16 19:09, 4年前 , 6F
修正一下回文需大於方面,應是需大於"等於"
09/16 19:09, 6F

09/16 22:03, 4年前 , 7F
所以變數設立的當下就會直接取值了嗎?
09/16 22:03, 7F

09/16 22:05, 4年前 , 8F
變數設立?是指什麼?宣告dim或是a=range.value
09/16 22:05, 8F

09/16 22:05, 4年前 , 9F
我還以為是開始運算後才依序進行
09/16 22:05, 9F

09/16 22:07, 4年前 , 10F
因為IF後是先用到p才輪到i 我以為用到i時才會取a
09/16 22:07, 10F

09/16 22:08, 4年前 , 11F
如果是宣告當下就會直接提取的話 我就懂了 感謝
09/16 22:08, 11F

09/16 22:10, 4年前 , 12F
於a=range.value時就會將所指定儲存格的值,寫入變數a內
09/16 22:10, 12F

09/16 22:12, 4年前 , 13F
內文巨集宣告dim時並沒有寫入,是執行到上述回文動作時才
09/16 22:12, 13F

09/16 22:12, 4年前 , 14F
寫入到變數a內
09/16 22:12, 14F
後續改良成這樣後可以正常運作了,只會抓有值的欄位, 雖然還能再改良,但暫時以能用優先,感謝 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
文章代碼(AID): #1TVrqQlL (Office)