[發問] 指定號碼在偶數欄的總個數及奇數欄的總次數

ziv976688

TEST.rar (6.25 KB)

下載次數: 7

2021-8-19 10:01

C2= (M$2︰DF$50)的偶數欄=B2的總個數
C3= (M$2︰DF$50)的偶數欄=B3的總個數
︰
︰
C50= (M$2︰DF$50)的偶數欄=B50的總個數


D2= (M$2︰DF$50)的偶數欄=B2之奇數欄總次數
D3= (M$2︰DF$50)的偶數欄=B3之奇數欄總次數
︰
︰
D50= (M$2︰DF$50)的偶數欄=B50之奇數欄總次數

請問︰
C2的函數公式 ?
D2的函數公式 ?
謝謝 !

ML089

C2 =COUNT(0/((B2=M$2:DE$99)*MOD(COLUMN(M:DE),2)))
D2 =SUM((B2=M$2:DE$99)*MOD(COLUMN(M:DE),2)*N$2:DF$99)

samwang

回復 1# ziv976688


Sub test()
Dim Arr, xD, T%, i&, j&, Tm
Tm = Timer
Set xD = CreateObject("Scripting.Dictionary")
R = Columns("M:DF").Find("*", , , , , 2).Row
Arr = Range("M1:DF" & R)
For j = 1 To UBound(Arr, 2) Step 2
    For i = 2 To UBound(Arr)
        T = Arr(i, j): If T = 0 Then GoTo 98
        xD(T & "/1") = xD(T & "/1") + 1
        xD(T & "/2") = xD(T & "/2") + Arr(i, j + 1)
    Next i
98: Next j
Arr = Range([C1], [B65536].End(3))
For i = 2 To UBound(Arr)
    For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
Next
[c2].Resize(UBound(Arr) - 1, 2) = Arr
MsgBox Timer - Tm
End Sub

ziv976688

回復 2# ML089
版主大大:
謝謝您的指導和幫忙~感恩

ziv976688

回復 3# samwang
S大大:
謝謝您的指導和幫忙~感恩

ziv976688

回復 3# samwang
S大大:您好!
不好意思~有點小問題~敬請賜正~謝謝

下載 (18.69 KB)

2021-8-20 05:47

TEST_1.rar (15.61 KB)

下載次數: 2

2021-8-20 05:48

samwang

回復 6# ziv976688


你的B欄的數字1~49 不見了，所以導致那個問題，謝謝

ziv976688

回復 7# samwang
不好意思~我疏忽了
謝謝您

ziv976688

回復 2# ML089
回復 3# samwang
TEST_0822.rar (31.76 KB)

下載次數: 3

2021-8-22 01:46

下列新增需求的語法~懇請二位大大繼續賜教。謝謝 !
.[A2] = ((M1:DF1)<>""的欄數)/2 & "個"   '列10
.[A4:A10] =當A$1<>""時，則顯示DATA!A欄=A$1期數之B:H號碼   '列12

'列32以下
.[E2:E50] =當D2>0時，則顯示D2/C2之值。   
.[G2:G50] =.[C2:C50]的值~由大而小依序往下排列。
.[H2:H50] =將.[G2:G50] <>""的排名(可重複)依序往下排列。
.[I2:I50] =當.[G2:G50]中<>""的某值=.[C2:C50]的某值時，則顯示.[C2:C50]的該某值同列的B欄值。  
.[J2:J50] =當.[I2:I50]中的某值=.[B2:B50]的某值時，則顯示.[B2:B50]的該某值同列的D欄值。  
.[K2:K50] =當.[I2:I50]中的某值=.[B2:B50]的某值時，則顯示.[B2:B50]的該某值同列的E欄值。

samwang

回復  ML089
回復  samwang


下列新增需求的語法~懇請二位大大繼續賜教。謝謝 !
.[A2] = ((M1F1) ...
ziv976688 發表於 2021-8-22 01:47

請測試看看，謝謝
Sub test()
Dim Arr, Brr(1 To 7), Crr, xD, T%, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
T = .[A1]
Arr = Range([DATA!h1], [DATA!a65536].End(3))
For i = 2 To UBound(Arr)
    If Arr(i, 1) = T Then
        For j = 2 To 8: n = n + 1: Brr(n) = Arr(i, j): Next
    End If
Next
.[A4].Resize(7) = Application.Transpose(Brr)
.[A2] = (.Cells(1, 256).End(xlToLeft).Column - 12) / 2
Arr = .Range(.[B2], .[e65536].End(3))
ReDim Crr(1 To UBound(Arr), 1 To 5)
For i = 1 To UBound(Arr)
    If Arr(i, 3) > 0 Then Arr(i, 4) = Arr(i, 3) / Arr(i, 2)
    Crr(i, 1) = Arr(i, 2): Crr(i, 2) = Arr(i, 2)
    Crr(i, 3) = Arr(i, 1): Crr(i, 4) = Arr(i, 3)
    Crr(i, 5) = Arr(i, 4)
Next
.[B2].Resize(UBound(Arr), 4) = Arr
With Range("g2").Resize(UBound(Crr), 5)
    .Value = Crr
    .Sort key1:=.Item(1), Order1:=2, Header:=xlNo
    Crr = .Value
End With
T = Application.Max(.Range("g2:g" & UBound(Crr)))
For i = 1 To UBound(Crr)
    Crr(i, 1) = T - Crr(i, 1) + 1
Next
[H2].Resize(UBound(Crr), 1) = Crr
End With
End Sub