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

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

¦^´_ 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
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ·R¤£¬O­n¨D¹ï¤è¡A¦Ó¬O­n¥Ñ¦Û¨­ªº¥I¥X¡C
ªð¦^¦Cªí ¤W¤@¥DÃD