[µo°Ý] ­pºâ­Ó§O­û¤u©ó¶g¤»¤W¯Z¦¸¼Æ

hkyan

¦pªG­n­pºâ­Ó§O­û¤u©ó¶g¤»¤W¯Z¦¸¼Æ(«DªÅ®æ),¤½¦¡¦p¦ó³]©w,½Ð«ü¾É

¤U¸ü (52.59 KB)

2014-4-12 17:06

aer

¦^´_ 1# hkyan

O2=COUNTIFS($B$1:$N$1,"*¶g¤»*",$B2:$N2,">""")

¦V¤U©Ô

hkyan

§Ú¨S»¡²M·¡,¦C1¬O¦Û­q®æ¦¡¤é´ÁÅã¥Ü,¨Ã«D¤å¦r¿é¤J,¬G¤½¦¡¤£¥i¦æ

¦¹¥~,­n¦A·s¼W¤@Äæ°O¿ý¤W¦¸¶g¤»¤W¯Z¤é´Á¶ZÂ÷¤µ¤é¦³¦h¤[,¦³¥i¯à¥Î¤½¦¡³]¸m¶Ü?

hkyan

count sat duty.rar (7.93 KB)

¤U¸ü¦¸¼Æ: 15

2014-4-13 15:50

½ÐÀ°¦£

GBKEE

¦^´_ 4# hkyan

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, i As Integer, ii As Integer, R As Range, d1 As Object, d2 As Object
   
4.     Set d1 = CreateObject("SCRIPTING.DICTIONARY")        '¦r¨åª«¥ó
   
5.     Set d2 = CreateObject("SCRIPTING.DICTIONARY")        '¦r¨åª«¥ó
   
6.     i = 2               '±qB2Äæ¼Æ ¶}©l
   
7.     With ActiveSheet    '«ü©w¤u§@ªí
   
8.         Do While .Cells(1, i) <> ""             '°õ¦æ°j°éªº±ø¥ó: iÄ檺²Ä¤@¦C <>""
   
9.             If Weekday(.Cells(1, i), 2) = 6 Then '¤é´Áªº¬P´Á="¶g¤»"
   
10.                 If Not Rng Is Nothing Then      '³]©w"¶g¤»"ªº¦ì¸m
    
11.                     Set Rng = Union(Rng, .Cells(1, i))
    
12.                 Else
    
13.                     Set Rng = .Cells(1, i)
    
14.                 End If
    
15.             End If
    
16.             i = i + 1                           '¤U¤@­ÓÄæ¼Æ
    
17.         Loop
    
18.         i = 2                                   '±qA2¦C¼Æ ¶}©l
    
19.         Do While .Cells(i, "A") <> ""           '°õ¦æ°j°éªº±ø¥ó: AÄ檺i¦C <>""
    
20.             '¦r¨åª«¥ó(KEY)¹ïÀ³¤@­Ó Item
    
21.             d1(.Cells(i, "A").Value) = ""       '¦r¨åª«¥ó(KEY)ªºITEM =""
    
22.             d2(.Cells(i, "A").Value) = ""
    
23.             For Each R In Rng                   '¨C¤@­Ó R ªº¬P´Á³£¬O"¶g¤»"
    
24.                 If R.Cells(i) <> "" Then        'R.Cells(i):  R¤U¤è²Äi­ÓCell
    
25.                     d1(.Cells(i, "A").Value) = Val(d1(.Cells(i, "A").Value)) + 1
    
26.                                                 '¦r¨åª«¥ó(KEY) =VAL(¦r¨åª«¥ó(KEY))+1 (¹ïÀ³ªº Item)
    
27.                     d2(.Cells(i, "A").Value) = Date - R
    
28.                                                 '¦r¨åª«¥ó(KEY) =·í¤é- R [¤Ñ¼Æ](¹ïÀ³ªº Item)
    
29.                 End If
    
30.             Next
    
31.             i = i + 1
    
32.         Loop
    
33.         Range("R2").Resize(d1.Count).Value = Application.Transpose(d1.ITEMS)
    
34.         Range("S2").Resize(d1.Count).Value = Application.Transpose(d2.ITEMS)
    
35.         
    
36.     End With
    
37. End Sub

½Æ»s¥N½X

yen956

¦^´_ 4# hkyan
(ª`·N¡G¬°¤FÅý¤é´Á§ó¨ãµo®i©Ê, ¨è·N±N§Aªº¼Ë¥»ªº²Î­pÄæ¦ì½Õ¨ì³Ì¥ªÃä)
¦p¤U¹Ï, ¸Õ¸Õ¬Ý¡G

1. Option Explicit
   
2. Private Sub CommandButton1_Click()
   
3.     Dim i, j, lastRow, lastCol As Integer
   
4.     Dim ¶Z¤µ As Long
   
5.     lastRow = [C65536].End(xlUp).Row
   
6.     lastCol = [IV1].End(xlToLeft).Column
   
7.     [A2].Resize(lastRow, 2) = ""
   
8.     For i = 4 To lastCol
   
9.         If Weekday(Cells(1, i), vbMonday) = 6 Then
   
10.             ¶Z¤µ = Date - Cells(1, i)
    
11.             For j = 2 To lastRow
    
12.                 If Cells(j, i) <> "" Then
    
13.                     Cells(j, 1) = Cells(j, 1) + 1   '¶g¤»¥[¯Z¤é¼Æ+1
    
14.                     Cells(j, 2) = ¶Z¤µ
    
15.                 End If
    
16.             Next
    
17.         End If
    
18.     Next
    
19. End Sub

½Æ»s¥N½X

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (94.81 KB)

2023-4-20 16:31

°õ¦æµ²ªG:

¤U¸ü (95.24 KB)

2023-4-20 16:32

Option Explicit
Sub TEST()
Dim Brr, Y, i&, j&, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([S1], Cells(Rows.Count, "A").End(3))
xR.Offset(1, 17).ClearContents: Brr = xR
For i = 2 To UBound(Brr)
   For j = 2 To UBound(Brr, 2) - 3
      If Format(Brr(1, j), "aaaa") = "¬P´Á¤»" And Trim(Brr(i, j)) <> "" Then
         Brr(i, UBound(Brr, 2) - 1) = Brr(i, UBound(Brr, 2) - 1) + 1
         If Brr(1, j) > Y(i) Then
            Brr(i, UBound(Brr, 2)) = Date - Brr(1, j)
            Y(i) = Brr(1, j)
         End If
      End If
   Next
Next
xR = Brr
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub

hcm19522

R2=SUMPRODUCT((TEXT(B$1:P$1,"AAA")="¶g¤»")*(B2:P2<>""))