帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2022-4-26 22:42 | 只看該作者

計算特定區間有顯示的儲存格個數

如附件壓縮檔
只要A欄位有顯示之區間就計算該區間的C欄位及E欄位裡有顯示的儲存格個數
直到找不到後續的A欄位儲存格有顯示為止(A~E欄位有顯示的列數為不一定)
例如附件圖片所示
A3儲存格有顯示,A20儲存格有顯示,所以計算C3~C19及E3~E19儲存格顯示的個數
1>L3儲存格內容等於A3儲存格格內容
2>M3儲存格內容等於B3儲存格格內容
3>N3儲存格內容等於C3~C19儲存格顯示的個數
4>O3儲存格內容等於E3~E19儲存格顯示的個數
以下類推

Image 002.jpg (143.93 KB)

日誌.rar (82.47 KB)

樓主熱帖

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

2^#

發表於 2022-4-27 09:33 | 只看該作者

本帖最後由 samwang 於 2022-4-27 09:34 編輯

回復 1# oak0723-1

請測試看看，謝謝
Sub test()
Dim Arr, Brr(), i&, i2&
Arr = [a2].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 6)
For i = 2 To UBound(Arr)
If Trim(Arr(i, 1)) <> "" Then
      Brr(i - 1, 1) = Arr(i, 1): Brr(i - 1, 2) = Arr(i, 2)
      If Trim(Arr(i, 3)) <> "" Then Brr(i - 1, 3) = 1
      If Trim(Arr(i, 5)) <> "" Then Brr(i - 1, 4) = 1
      For i2 = i + 1 To UBound(Arr)
         If Trim(Arr(i2, 1)) <> "" Then Exit For
         If Trim(Arr(i2, 3)) <> "" Then Brr(i - 1, 3) = Brr(i - 1, 3) + 1
         If Trim(Arr(i2, 5)) <> "" Then Brr(i - 1, 4) = Brr(i - 1, 4) + 1
      Next
      Brr(i - 1, 5) = Brr(i - 1, 2) / Brr(i - 1, 3)
      Brr(i - 1, 6) = Brr(i - 1, 2) / Brr(i - 1, 4)
End If
Next
Range("L3").Resize(UBound(Brr), 6) = Brr
End Sub

TOP

hcm19522

大學生 Rank: 4

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

熱烈參與勳章

3^#

發表於 2022-4-27 11:14 | 只看該作者

https://blog.xuite.net/hcm19522/twblog/590359821

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

TOP

oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

4^#

發表於 2022-4-29 21:34 | 只看該作者

回復 2# samwang

謝謝~感恩~

TOP

oak0723-1

中學生 Rank: 2

帖子: 222
主題: 56
精華: 0
積分: 285
點名: 0
作業系統: window
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2010-8-30
最後登錄: 2024-4-22

論壇贊助勳章論壇榮譽勳章

5^#

發表於 2022-4-30 06:20 | 只看該作者

回復 3# hcm19522

抱歉,我不太懂如何使用(如附件檔案)

日誌 -函數.rar (134.86 KB)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-29

6^#

發表於 2022-4-30 09:05 | 只看該作者

Sub TEST_A1()
Dim Arr, Brr, R&, i&, j%, V, S&, X(6)
R = Range("a:e").Find("*", , , , 1, 2).Row
Arr = Range("a2:e" & R + 1)
ReDim Brr(1 To R, 1 To 6)
For i = 2 To R - 1
If Trim(Arr(i, 1)) <> "" Then
   X(1) = Trim(Arr(i, 1)): X(2) = Trim(Arr(i, 2)):  S = i - 1
   For j = 3 To 6: X(j) = 0: Next
End If
X(3) = X(3) - (Trim(Arr(i, 3)) <> ""): X(5) = X(2) / X(3)
X(4) = X(4) - (Trim(Arr(i, 5)) <> ""): X(6) = X(2) / X(4)
If Trim(Arr(i + 1, 1)) <> "" Or i = R - 1 Then
   For j = 1 To 6: Brr(S, j) = X(j): Next
End If
Next i
[l3].Resize(R, 6) = Brr
End Sub

'==========================

TOP

oak0723-1