返回列表 上一主題 發帖

[發問] 計算工作表(間隔)

peter95

帖子
49 
主題
15 
精華
0 
積分
92 
點名
0  
作業系統
win7 
軟體版本
office2001 
閱讀權限
20 
性別
男 
註冊時間
2012-4-10 
最後登錄
2024-8-9 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2023-9-5 23:27 | 只看該作者

[發問] 計算工作表(間隔)

請版上大大幫忙,求如何計算間隔次數
附上圖檔和原始EXCEL檔案
謝謝大家幫忙

Book1.rar (8.13 KB)

0               
1        間隔1次出現大於0       
0               
0               
1        間隔2次出現大於0       
1        間隔0次出現大於0       
0               
0               
0               
1        間隔3次出現大於0       
1        間隔0次出現大於0       
0               
0               
0               
1        間隔3次出現大於0       
0               
1        間隔0次出現大於0       
1        間隔0次出現大於0       
0               
0               
1        間隔2次出現大於0       
0               
0               
0               
0               
1        間隔4次出現大於0
收藏 分享
學習 學習 一直學習

星空乂羽翼

帖子
63 
主題
7 
精華
0 
積分
90 
點名
60  
作業系統
windows 7 
軟體版本
2013 
閱讀權限
20 
性別
男 
註冊時間
2022-9-23 
最後登錄
2024-12-16 

2023年全勤獎章
2#
發表於 2023-9-6 10:26 | 只看該作者
本帖最後由 星空乂羽翼 於 2023-9-6 10:27 編輯
  1. Sub text()
  2.     Range("A1").Select
  3.     Dim x As Integer
  4.     Dim y As Integer
  5.    
  6.     While ActiveCell.Value <> ""
  7.    
  8.     x = ActiveCell.Value
  9.    
  10.    
  11.     If x = 0 Then
  12.     y = y + 1
  13.     ActiveCell.Offset(1, 0).Range("A1").Select
  14.    
  15.     Else
  16.     ActiveCell.Offset(0, 1).Range("A1").Select
  17.     ActiveCell.Value = y
  18.     ActiveCell.Offset(1, -1).Range("A1").Select
  19.     y = 0
  20.       
  21.     End If
  22.     Wend
  23. End Sub
複製代碼

TOP

星空乂羽翼

帖子
63 
主題
7 
精華
0 
積分
90 
點名
60  
作業系統
windows 7 
軟體版本
2013 
閱讀權限
20 
性別
男 
註冊時間
2022-9-23 
最後登錄
2024-12-16 

2023年全勤獎章
3#
發表於 2023-9-6 10:41 | 只看該作者
回復 2# 星空乂羽翼

後學剛學習VBA
上述代碼是由目前已學的觀念進行撰寫
若寫得不好請見諒，感謝！

TOP

peter95

帖子
49 
主題
15 
精華
0 
積分
92 
點名
0  
作業系統
win7 
軟體版本
office2001 
閱讀權限
20 
性別
男 
註冊時間
2012-4-10 
最後登錄
2024-8-9 
4#
發表於 2023-9-6 15:54 | 只看該作者
本帖最後由 peter95 於 2023-9-6 16:02 編輯

感謝幫忙，我來試看看，謝謝你
學習 學習 一直學習

TOP

hcm19522

帖子
1391 
主題
4 
精華
0 
積分
1401 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2015-9-11 
最後登錄
2024-12-16 

熱烈參與勳章
5#
發表於 2023-9-7 14:42 | 只看該作者
https://hcm19522.blogspot.com/2023/09/0-11771.html
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1447 
主題
40 
精華
0 
積分
1471 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-12-5 
6#
發表於 2023-11-9 11:33 | 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列,學習方案如下,請各位前輩指教

執行前:


執行結果:



Option Explicit
Sub TEST()
Dim Brr, i&, N&
Brr = Range([A1], [A65536].End(3))
For i = 1 To UBound(Brr)
   If Val(Brr(i, 1)) > 0 Then Brr(i, 1) = N: N = 0 Else Brr(i, 1) = "": N = N + 1
Next
[E1].Resize(UBound(Brr)) = Brr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
返回列表 上一主題