ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

¦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)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

¦^´_ 1# b9208
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D(1 To 2) As Object, i As Integer, M As String
  4.     Dim R As Integer, C As Integer, A As Range
  5.     Set D(1) = CreateObject("scripting.dictionary")    '¦r¨åª«¥ó
  6.     Set D(2) = CreateObject("scripting.dictionary")
  7.     With Sheets("©ú²Ó")
  8.         i = 6
  9.         Do While .Cells(i, "d") <> ""
  10.             M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F")
  11.             D(1)(M) = D(1)(M) + 1                                                               '¥þ³¡
  12.             M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F") & .Cells(i, "L")
  13.             D(2)(M) = D(2)(M) + 1                                                               '°Ï°ì
  14.             i = i + 1
  15.         Loop
  16.     End With
  17.      With Sheets("²Î­p")
  18.         For Each A In .Range("F3:J12,F18:J27,F33:J42,F48:J57").Areas                     '­×¥¿¬°§Aªº¥þ³¡ ¤Î °Ï°ì ªº½d³ò
  19.             With A
  20.                 For R = 3 To .Rows.Count - 1
  21.                     For C = 2 To .Columns.Count
  22.                         If .Cells(1) = "¥þ³¡" Then                  '¥þ³¡
  23.                             .Cells(R, C) = D(1)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C))
  24.                         Else                                        '°Ï°ì
  25.                              .Cells(R, C) = D(2)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C) & .Cells(1))
  26.                         End If
  27.                     Next
  28.                 Next
  29.                 For C = 2 To .Columns.Count
  30.                     .Cells(.Rows.Count, C).FormulaR1C1 = "=SUM(R[-" & .Rows.Count - 3 & "]C:R[-1]C)"  '¤½¦¡
  31.                     .Cells(.Rows.Count, C) = .Cells(.Rows.Count, C).Value
  32.                 Next
  33.         
  34.             End With
  35.         Next
  36.      End With
  37. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 2# GBKEE
«D±`·PÁª©¥D¦^ÂÐ
¤U¦C¸É¥R»¡©ú¡G
1. ¦U¿é¥Xªí®æ¤§¶g¦¸¤Î³æ¦ì¡A¥Ñµ{¦¡¹Bºâ«á¦Û°Ê¥N¥X¡C
2. ¨ÌB4:B13³]©w¿z¿ï³æ¦ì¡A¿é¥X¿z¿ï³æ¦ì¥þ³¡²Î­p¸ê®Æªí¡C¡]¦pÀɮפºQWE,ASD³æ¦ì¡^
3. ¦pªGB18:B21¦³³]©w¿z¿ï°Ï°ì¡A«h¦A¼W¥[¿é¥X¸Ó°Ï°ì²Î­p¸ê®Æªí¡C¡]¦pÀɮפºQWE,ASD³æ¦ì¤§¥_³¡¸ê®Æ¡^
¥H¤W½Ð°Ñ¦Òªþ¥ó

W111.rar (17.22 KB)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 3# b9208
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Dim D(1 To 2) As Object, ¶g¦¸ As Object, ²Î­p³æ¦ì As Variant, Ar        'Dim : ¦¹¼Ò²Õªº¨p¥ÎÅܼÆ(¶È¦¹¼Ò²Õ¥i¥Î)
  3. Sub EX()
  4.     Dim i As Integer, ii As Integer, M As String, Rng As Range
  5.     'Dim Rng As Range, M As String
  6.     'Dim R As Integer, C As Integer
  7.     Set D(1) = CreateObject("scripting.dictionary")    '¦r¨åª«¥ó
  8.     Set D(2) = CreateObject("scripting.dictionary")
  9.     Set ¶g¦¸ = CreateObject("scripting.dictionary")
  10.     With Sheets("²Î­p")
  11.         i = Application.CountA(.[b4:b13])
  12.         ²Î­p³æ¦ì = Join(Application.Transpose(.Range(.[b4], .[b4].Offset(i - 1))), ",")        '²Î­p³æ¦ì=QWE,ASD
  13.     End With
  14.     With Sheets("©ú²Ó")
  15.         i = 6
  16.         Do While .Cells(i, "D") <> ""
  17.             ' "," & ²Î­p³æ¦ì & "," -> ,QWE,ASD,
  18.             If InStr("," & ²Î­p³æ¦ì & ",", "," & .Cells(i, "F") & ",") Then   '¤ñ¹ï¨ì  ,QWE,   ,ASD, .....
  19.                 ¶g¦¸(.Cells(i, "F").Value) = ¶g¦¸(.Cells(i, "F").Value) & "," & Mid(.Cells(i, "E"), 1, 4)
  20.                 M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F")
  21.                 D(1)(M) = D(1)(M) + 1                                                               '¥þ³¡
  22.                 M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F") & .Cells(i, "L")
  23.                 D(2)(M) = D(2)(M) + 1                                                               '°Ï°ì
  24.             End If
  25.             i = i + 1
  26.         Loop
  27.     End With
  28.     ²Î­p³æ¦ì = Split(²Î­p³æ¦ì, ",")                                             ' QWE,ASD,ZXC ¸m©ó°}¦C
  29.     With Sheets("²Î­p")
  30.         .[F:J].Clear
  31.         For i = 0 To UBound(²Î­p³æ¦ì)
  32.             Ar = Array("¥þ³¡", "³æ¦ì", "MON", "TUE", "WED", "THU", "FRI", "SAT", "SUN", "¤p­p")
  33.             If i = 0 Then
  34.                 Set Rng = .[F3]
  35.             Else
  36.                 Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6)          '¨C±iªí®æ¶¡¹j¤­¦C
  37.             End If
  38.             ¶g¦¸(²Î­p³æ¦ì(i)) = Mid(¶g¦¸(²Î­p³æ¦ì(i)), 2)
  39.             ¶g¦¸(²Î­p³æ¦ì(i)) = Split(¶g¦¸(²Î­p³æ¦ì(i)), ",")                   '¨ú±o¶g¦¸
  40.    
  41.             ªí®æ»s³y Rng, i
  42.             ªí®æ²Î­p Rng.CurrentRegion
  43.             
  44.             For ii = 0 To Application.CountA(.Range("B18:B21")) - 1
  45.                 Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6)          '¨C±iªí®æ¶¡¹j¤­¦C
  46.                 Ar(0) = .[B18].Offset(ii)
  47.                 ªí®æ»s³y Rng, i
  48.                 ªí®æ²Î­p Rng.CurrentRegion
  49.             Next
  50.     Next
  51. End With
  52. End Sub
  53. Private Sub ªí®æ»s³y(Rng As Range, i As Integer)
  54.     Rng.Resize(UBound(Ar) + 1).Value = Application.Transpose(Ar)
  55.     With Rng.Offset(, 1).Resize(1, UBound(¶g¦¸(²Î­p³æ¦ì(i))) + 1)
  56.         .Value = ¶g¦¸(²Î­p³æ¦ì(i))
  57.         .Offset(1) = ²Î­p³æ¦ì(i)
  58.     End With
  59.     Rng.CurrentRegion.Borders.LineStyle = 1  '®Ø½u
  60. End Sub
  61. Private Sub ªí®æ²Î­p(Rng As Range)
  62.     Dim R As Integer, C As Integer
  63.     With Rng
  64.         For R = 3 To .Rows.Count - 1
  65.             For C = 2 To .Columns.Count
  66.                 If .Cells(1) = "¥þ³¡" Then                  '¥þ³¡
  67.                     .Cells(R, C) = D(1)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C))
  68.                 Else                                        '°Ï°ì
  69.                     .Cells(R, C) = D(2)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C) & .Cells(1))
  70.                 End If
  71.             Next
  72.         Next
  73.         For C = 2 To .Columns.Count
  74.             .Cells(.Rows.Count, C).FormulaR1C1 = "=SUM(R[-" & .Rows.Count - 3 & "]C:R[-1]C)"  '¤½¦¡
  75.             .Cells(.Rows.Count, C) = .Cells(.Rows.Count, C).Value
  76.         Next
  77.     End With
  78. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 4# GBKEE
«e½ú±z¦n
VBA¸g°õ¦æ´ú¸Õ«á¡Aªí®æ¦ì¸m¤Î¼Æ¾Ú³£¥¿½T¡A
¦ý¨C¶g¼Æ¾Ú³£­«½Æ¥X²{¦hµ§¡C
¨Ò¦p2012¦~«×¦³1201~1251¶g¡A­p51¶gµ§¡A
¦ýµ{¦¡°õ¦æ«á½T²£¥X6000¦hµ§¶g¦¸¸ê®Æ¡C
¤£À´­ì¦]
«D±`·PÁ«ü¾É
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 5# b9208
¤W¶ÇÀɮ׬ݬÝ
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 6# GBKEE
Àɮצpªþ¥ó
ÁÂÁÂ

    W04.rar (25.29 KB)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 7# b9208
­ü¶g¦¸¨S¦³§Ë¦n,§ó¥¿¦p¤U
  1. Option Explicit
  2. Dim D(1 To 2) 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 ¶g¦¸ = CreateObject("scripting.dictionary")
  8.     With Sheets("²Î­p")
  9.         i = Application.CountA(.[b4:b13])
  10.         ²Î­p³æ¦ì = Join(Application.Transpose(.Range(.[b4], .[b4].Offset(i - 1))), ",")        '²Î­p³æ¦ì=QWE,ASD
  11.     End With
  12.     With Sheets("©ú²Ó")
  13.         i = 6
  14.         Do While .Cells(i, "D") <> ""
  15.             ' "," & ²Î­p³æ¦ì & "," -> ,QWE,ASD,
  16.             If InStr("," & ²Î­p³æ¦ì & ",", "," & .Cells(i, "F") & ",") Then   '¤ñ¹ï¨ì  ,QWE,   ,ASD, .....
  17.                
  18.                 If InStr("," & ¶g¦¸(.Cells(i, "F").Value) & ",", "," & Mid(.Cells(i, "E"), 1, 4)) & "," = 0 Then '²Î­p³æ¦ì: ¤ñ¹ï¶g¦¸¤£¦s¦b, .....
  19.                     ¶g¦¸(.Cells(i, "F").Value) = IIf(¶g¦¸(.Cells(i, "F").Value) = "", "", ¶g¦¸(.Cells(i, "F").Value) & ",") & Mid(.Cells(i, "E"), 1, 4)
  20.                 End If
  21.                
  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                                                               '°Ï°ì
  26.             End If
  27.             i = i + 1
  28.         Loop
  29.     End With
  30.     With Sheets("²Î­p")
  31.         .[F:IQ].Clear
  32.         For i = 0 To Application.CountA(.Range("B4:B13")) - 1
  33.             Ar = Array("¥þ³¡", "³æ¦ì", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun", "¤p­p")
  34.             If i = 0 Then
  35.                 Set Rng = .[F3]
  36.             Else
  37.                 Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6)          '¨C±iªí®æ¶¡¹j¤­¦C
  38.             End If
  39.            
  40.             ¶g¦¸(.Range("B4").Offset(i).Value) = Split(¶g¦¸(.Range("B4").Offset(i).Value), ",")
  41.             '¨ú±o²Î­p³æ¦ì¤§¶g¦¸
  42.    
  43.             ªí®æ»s³y Rng, .Range("B4").Offset(i)
  44.             ªí®æ²Î­p Rng.CurrentRegion
  45.             
  46.             For ii = 0 To Application.CountA(.Range("B18:B21")) - 1
  47.                 Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6)          '¨C±iªí®æ¶¡¹j¤­¦C
  48.                 Ar(0) = .[B18].Offset(ii)
  49.                 ªí®æ»s³y Rng, .Range("B4").Offset(i)
  50.                 ªí®æ²Î­p Rng.CurrentRegion
  51.             Next
  52.     Next
  53. End With
  54. End Sub
  55. Private Sub ªí®æ»s³y(Rng As Range, ³æ¦ì As String)
  56.     Rng.Resize(UBound(Ar) + 1).Value = Application.Transpose(Ar)
  57.     With Rng.Offset(, 1).Resize(1, UBound(¶g¦¸(³æ¦ì)) + 1)
  58.         .Value = ¶g¦¸(³æ¦ì)
  59.         .Offset(1) = ³æ¦ì
  60.     End With
  61.     Rng.CurrentRegion.Borders.LineStyle = 1  '®Ø½u
  62. End Sub
  63. Private Sub ªí®æ²Î­p(Rng As Range)
  64.     Dim R As Integer, C As Integer
  65.     With Rng
  66.         For R = 3 To .Rows.Count - 1
  67.             For C = 2 To .Columns.Count
  68.                 If .Cells(1) = "¥þ³¡" Then                  '¥þ³¡
  69.                     .Cells(R, C) = D(1)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C))
  70.                 Else                                        '°Ï°ì
  71.                     .Cells(R, C) = D(2)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C) & .Cells(1))
  72.                 End If
  73.             Next
  74.         Next
  75.         For C = 2 To .Columns.Count
  76.             .Cells(.Rows.Count, C).FormulaR1C1 = "=SUM(R[-" & .Rows.Count - 3 & "]C:R[-1]C)"  '¤½¦¡
  77.             .Cells(.Rows.Count, C) = .Cells(.Rows.Count, C).Value
  78.         Next
  79.     End With
  80. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 8# GBKEE
GBKEEª©¥D
«D±`·PÁ«ü¾É
°õ¦æok
¦pªGdÄæ¦Ü³Ì«á¤@µ§¸ê®Æ¨ä¤¤¦³ªÅ®æ¡A«h°õ¦æ¤£§¹¾ã¡C
¤µ­×­q¼W¥[§PÂ_   Do While .Cells(i, "D") <> "" Or .Cells(i, "F") <> ""
°õ¦æ´Nok
¥t¤@­×­q±NDo°j°é§ï¦¨For°j°é¡A¤]ok¡C
u = .[d65536].End(xlUp).Row
For i = 6 To u

½Ð±Ð©óExcel 2010¤¤§PÂ_³Ì«á¤@µ§¸ê®Æ¦C¡AÀ³¦p¦ó­×§ï¤U­±¦¡¤l¡C
u = .[d65536].End(xlUp).Row
ÁÂÁ«ü¾É
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 9# b9208
  1. Sub Ex()
  2.     Dim U As Long, E As String
  3.     Select Case Application.Version
  4.         Case "12.0"
  5.             E = 2007
  6.         Case "11.0"
  7.             E = 2003
  8.         Case "10.0"
  9.             E = 2002
  10.         Case "9.0"
  11.             E = 2000
  12.         Case "8.0"
  13.             E = 97
  14.         Case "7.0"
  15.             E = 95
  16.         Case "5.0"
  17.             E = "5.0"
  18.         Case Else
  19.             E = "¥¼ª¾"
  20.     End Select
  21.     With ActiveSheet
  22.       MsgBox "Excel " & E & " ª©¥»ªºÁ`¦C¼Æ:  " & .Rows.Count
  23.         U = .Range("d" & .Rows.Count).End(xlUp).Row
  24.     End With
  25. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¤@­Ó¤Hªº§Ö¼Ö¡D¤£¬O¦]¬°¥L¾Ö¦³±o¦h¡A¦Ó¬O¦]¬°¥L­p¸û±o¤Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD