[µo°Ý] ¥ÎVBA¨Ó°õ¦æSUMPRODUCT¦h±ø¥ó²Î­p

b9208

¦U¦ì«e½ú

­ì¨Ï¥ÎSUMPRODUCT¦h±ø¥ó²Î­p¨Ó°õ¦æ¤»­Ó¤ë¸ê®Æ¡A¦ý¤µ¤é»Ý°õ¦æ¤G¦~¸ê®Æ¡A¹Bºâ®É¶¡ªø¡A¤¤³~­×§ï¸ê®Æ¤S­n­«·s¹Bºâ¡Aµ¥«Ý®É¶¡ªø¡C
©Ò¥H½Ð±Ð«e½ú¡A¦p¦ó¥ÎVBA¨Ó°õ¦æSUMPRODUCT¦h±ø¥ó²Î­p¹Bºâ¡C

W1.rar (11.63 KB)

¤U¸ü¦¸¼Æ: 21

2013-4-2 14:10

GBKEE

¦^´_ 20# b9208
ªþÀÉ Ex()µ{§Ç¤£¬O 8# ªºEx()µ{§Ç

1. Option Explicit
   
2. Dim D(1 To 3) As Object, ¶g¦¸ As Object, Ar '        'Dim : ¦¹¼Ò²Õªº¨p¥ÎÅܼÆ(¶È¦¹¼Ò²Õ¥i¥Î)
   
3. Sub EX()
   
4.     Dim i As Integer, ii As Integer, M As String, Rng As Range, ²Î­p³æ¦ì As Variant
   
5.     Set D(1) = CreateObject("scripting.dictionary")    '¦r¨åª«¥ó
   
6.     Set D(2) = CreateObject("scripting.dictionary")
   
7.     Set D(3) = CreateObject("scripting.dictionary")
   
8.     Set ¶g¦¸ = CreateObject("scripting.dictionary")
   
9.     With Sheets("²Î­p")
   
10.         i = Application.CountA(.[b4:b13])
    
11.         ²Î­p³æ¦ì = Join(Application.Transpose(.Range(.[b4], .[b4].Offset(i - 1))), ",")        '²Î­p³æ¦ì=QWE,ASD
    
12.     End With
    
13.     With Sheets("©ú²Ó")
    
14.         i = 6
    
15.         Do While .Cells(i, "D") <> ""
    
16.             ' "," & ²Î­p³æ¦ì & "," -> ,QWE,ASD,
    
17.             If InStr("," & ²Î­p³æ¦ì & ",", "," & .Cells(i, "F") & ",") Then   '¤ñ¹ï¨ì  ,QWE,   ,ASD, .....
    
18.                 M = .Cells(i, "D") & .Cells(i, "E") & .Cells(i, "F") & .Cells(i, "L")
    
19.                 If D(3)(M) = "" Then   ' *** ³o¸Ì§PÂ_4Äæ³£¬Û¦P¬°¤@µ§¸ê®Æ ****
    
20.                     D(3)(M) = 0
    
21.                     If InStr("," & ¶g¦¸(.Cells(i, "F").Value) & ",", "," & Mid(.Cells(i, "E"), 1, 4)) & "," = 0 Then '²Î­p³æ¦ì: ¤ñ¹ï¶g¦¸¤£¦s¦b, .....
    
22.                         ¶g¦¸(.Cells(i, "F").Value) = IIf(¶g¦¸(.Cells(i, "F").Value) = "", "", ¶g¦¸(.Cells(i, "F").Value) & ",") & Mid(.Cells(i, "E"), 1, 4)
    
23.                     End If
    
24.                     M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F")
    
25.                     D(1)(M) = D(1)(M) + 1                                                               '¥þ³¡
    
26.                     M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F") & .Cells(i, "L")
    
27.                     D(2)(M) = D(2)(M) + 1                                                               '°Ï°ì
    
28.                 End If
    
29.             End If
    
30.             i = i + 1
    
31.         Loop
    
32.     End With
    
33.     With Sheets("²Î­p")
    
34.         .[F:IQ].Clear
    
35.         For i = 0 To Application.CountA(.Range("B4:B13")) - 1
    
36.             Ar = Array("¥þ³¡", "³æ¦ì", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun", "¤p­p")
    
37.             If i = 0 Then
    
38.                 Set Rng = .[F3]
    
39.             Else
    
40.                 Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6)          '¨C±iªí®æ¶¡¹j¤­¦C
    
41.             End If
    
42.            
    
43.             ¶g¦¸(.Range("B4").Offset(i).Value) = Split(¶g¦¸(.Range("B4").Offset(i).Value), ",")
    
44.             '¨ú±o²Î­p³æ¦ì¤§¶g¦¸
    
45.    
    
46.             ªí®æ»s³y Rng, .Range("B4").Offset(i)
    
47.             ªí®æ²Î­p Rng.CurrentRegion
    
48.             
    
49.             For ii = 0 To Application.CountA(.Range("B18:B21")) - 1
    
50.                 Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6)          '¨C±iªí®æ¶¡¹j¤­¦C
    
51.                 Ar(0) = .[B18].Offset(ii)
    
52.                 ªí®æ»s³y Rng, .Range("B4").Offset(i)
    
53.                 ªí®æ²Î­p Rng.CurrentRegion
    
54.             Next
    
55.     Next
    
56. End With
    
57. End Sub

½Æ»s¥N½X

b9208

¦^´_ 19# GBKEE

¤W¶ÇÀÉ®×
·q½Ð«ü¾É
W0510.rar (39.91 KB)

¤U¸ü¦¸¼Æ: 15

2013-5-10 13:17

GBKEE

¦^´_ 18# b9208
¨º¶g¦¸¼Æ¦r¦p¦ó¨ú±o¤Î¿é¥X !!!
¥h±¼MID: ¨ú[¥Ó½Ð½s¸¹]§¹¥þ¬Û¦P,ÁÙ­nÂkÃþ¨ì¶g¦¸¤¤
½Ð¤W¶Ç½d¨Ò¹Ïªí¬Ý¬Ý

b9208

¦^´_ 16# GBKEE
Dear GBKEE
¦pªG¨Ì·Ó¤è¦¡­×­q¡G
Mid(.Cells(i, "E"), 1, 4)   ­×§ï¬°  .Cells(i, "E")
Mid(.Cells(1, C), 1, 4)    ­×§ï¬°  .Cells(1, C)

¨º¶g¦¸¼Æ¦r¦p¦ó¨ú±o¤Î¿é¥X
ÁÂÁÂ

freeffly

¯d­Ó¾Ç²ß¬ö¿ý
¥Î¦r¨å¦b¬Y¨Ç±¡ªp³t«×¦n¹³¤£§Ö
³o­Ó¨Ò¤l§Ú¤j·§¥u·|·Q¨ì¥ÎSQLªº¤è¦¡³B²z

GBKEE

¦^´_ 15# b9208
©Ò¦³µ{¦¡½X¤¤
Mid(.Cells(i, "E"), 1, 4)   ­×§ï¬°  .Cells(i, "E")
Mid(.Cells(1, C), 1, 4)    ­×§ï¬°  .Cells(1, C)

1.¥i¤@¤@¦Û¦æ­×§ï
2.Vba µøµ¡«ü¥O ½s¿è->¨ú¥N

b9208

¦^´_ 8# GBKEE
Dear GBKEE
¦p¤U¦¡¤l¡A²Ö­p¦¸¼Æ
22.   M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F")
23.   D(1)(M) = D(1)(M) + 1               '¥þ³¡
24.   M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F") & .Cells(i, "L")
25.   D(2)(M) = D(2)(M) + 1               '°Ï°ì  

¦p±ý­pºâ¬Û¦P¸ê®Æ¥u­pºâ¤@µ§¡C¦p
22. M = .Cells(i, "D") & .Cells(i, "E") & .Cells(i, "F") ¦¹¤T¶µ¸ê®Æ¬Û¦PªÌ¥u­pºâ¤@µ§
24. M = .Cells(i, "D") & .Cells(i, "E") & .Cells(i, "F") & .Cells(i, "L")  ¦¹¥|¶µ¸ê®Æ¬Û¦PªÌ¥u­pºâ¤@µ§

·PÁ«ü¾É

b9208

¦^´_ 13# GBKEE
«D±`·PÁ«ü¾É

GBKEE

¦^´_ 12# b9208

1. Private Sub ªí®æ²Î­p(Rng As Range)
   
2.     Dim R As Integer, C As Integer
   
3.     With Rng
   
4.         For R = 3 To .Rows.Count - 1
   
5.             For C = 2 To .Columns.Count
   
6.                 If .Cells(1) = "¥þ³¡" Then                  '¥þ³¡
   
7.                     .Cells(R, C) = D(1)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C))
   
8.                 Else                                        '°Ï°ì
   
9.                     .Cells(R, C) = D(2)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C) & .Cells(1))
   
10.                 End If
    
11.                 '********
    
12.                 If .Cells(R, C) = "" Then .Cells(R, C) = 0   
    
13.                 '********
    
14.             Next
    
15.         Next
    
16.         For C = 2 To .Columns.Count
    
17.             .Cells(.Rows.Count, C).FormulaR1C1 = "=SUM(R[-" & .Rows.Count - 3 & "]C:R[-1]C)"  '¤½¦¡
    
18.             .Cells(.Rows.Count, C) = .Cells(.Rows.Count, C).Value
    
19.         Next
    
20.     End With
    
21. End Sub

½Æ»s¥N½X