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

[µo°Ý] ¤ñ¹ï¦hµ§¸ê®Æ

[µo°Ý] ¤ñ¹ï¦hµ§¸ê®Æ

DATA.zip (971.83 KB)
¦pªþÀÉ
¦³¦hµ§°Ó«~³ø»ù¸ê®Æ
¦ý¬O¨CºØ°Ó«~ªº¸ê®Æ¤é´Á¤£§¹¥þ¤@¼Ë
²{¦b·Q¶]²Î­p¦^Âk ©Ò¥H·Q¨ú¥X³ø»ù¤é´Áªº¥æ¶°
§Y¥u¦³·í¬Y¤é´Á¦³°Ó«~¬Ò¦³³ø»ù¸ê®Æ®É¤~±Ä¥Î §_«h±Ë±ó
¤@¶}©l·Q¨ì¨Ï¥Îcountif §ì¥X¬Ò¦³ªº¸ê®Æ
¦ý®Ä²v¤£¬Æ¦n µM«á·Q¨ì¥Î°}¦C
¤£ª¾¹D¦p¦ó¤ñ¹ï¤£¦P°}¦C¶¡ªº¸ê®Æ©O?
ex. °}¦Ca()¤¤¥ô¤@µ§¸ê®Æ(¤é´Á)­Y¦s¦b©ó¨ä¥L©Ò¦³°}¦C«h«O¯d
³Ì¤j°ÝÃDÂI¦b©ó¬Y¤@¤é´ÁÁö¦s¦b©ó©Ò¦³°}¦C
¦ý¬O¦ì¸m¤£©T©w
©Ò¥HµLªk¥H²³æ°j°é¶]§¹
­Y¬O³sÄò¨Ï¥ÎÂù°j°éªº¸Ü¦n¹³·|«ÜºC(¦]¬°¦³¦h­Ó°}¦C)
©Ò¥H·Qª¾¹D¦³¨S¦³§Ö³t¤ñ¸û¸ê®Æ¦s¦bªº¤èªk
©Î¬O¦³¨ä¥L¥i¥H¤ñ¹ï¤j¶q¸ê®Æªº¤è¦¡?
·PÁÂ~

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

°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Crr, V, Y, R&, i&, j&, N&, T$, Tv
Dim xR As Range, Sh As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = Sheets("5Y-Data")
Set xR = Intersect(Sh.[A1].CurrentRegion, Sh.UsedRange.Offset(2, 0))
Brr = xR
For i = 1 To UBound(Brr)
   For j = 1 To UBound(Brr, 2) Step 2
      T = Brr(i, j): Tv = Brr(i, j + 1)
      If i = 1 Then T = "Date"
      If T = "" Then GoTo i01
      Y(T) = Y(T) + 1: Y(T & "|c") = j \ 2 + 1
      Y(T & "|" & Y(T & "|c")) = Tv
      If Y(T) = 6 Then R = R + 1
   Next
i01:
Next
ReDim Crr(1 To R, 1 To 7)
For Each V In Y.keys
   If Y(V) = 6 And InStr(V, "|") = 0 Then
      N = N + 1: Crr(N, 1) = V
      For j = 1 To 6
         Crr(N, j + 1) = Y(V & "|" & j)
      Next
   End If
Next
With Sh.[O3].Resize(R, 7)
   .EntireColumn.ClearContents
   .Value = Crr
End With
Set Y = Nothing: Set xR = Nothing: Set Sh = Nothing: Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 2# white945

¦n­C!
¦r¨å·f°t°}¦CªGµM¬O¾ã²z¸ê®Æªº¦n¤u¨ã
§Ú¦A¬ã¨s¤@¤U
·PÁ§A:)

TOP

¦^´_ 1# lalalada
  1. Sub §ì¨ú¤é´Á¥æ¶°()
  2. Dim Ay(), Ty()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Set d1 = CreateObject("Scripting.Dictionary")
  5. ar = Range("A1").CurrentRegion.Value
  6. ReDim Preserve Ty(0)
  7. Ty(0) = "Date"
  8. For j = 1 To UBound(ar, 2) Step 2
  9. k = k + 1
  10. ReDim Preserve Ty(k)
  11. Ty(k) = ar(3, j + 1)
  12.   For i = 5 To UBound(ar, 1)
  13.   If IsDate(ar(i, j)) Then
  14.     d(ar(i, j)) = d(ar(i, j)) + 1
  15.     If IsEmpty(d1(ar(i, j))) Then
  16.       ReDim Preserve Ay(0)
  17.       Ay(0) = ar(i, j + 1)
  18.       d1(ar(i, j)) = Ay
  19.     Else
  20.       Ay = d1(ar(i, j))
  21.       ReDim Preserve Ay(UBound(Ay) + 1)
  22.       Ay(UBound(Ay)) = ar(i, j + 1)
  23.       d1(ar(i, j)) = Ay
  24.     End If
  25.     Erase Ay
  26.   End If
  27.   Next
  28. Next
  29. For Each ky In d.keys
  30.   If d(ky) <> k Then d1.Remove ky
  31. Next
  32. Cells(3, k * 2 + 3).Resize(, k + 1) = Ty
  33. Cells(4, k * 2 + 3).Resize(d1.Count, 1) = Application.Transpose(d1.keys)
  34. Cells(4, k * 2 + 4).Resize(d1.Count, k) = Application.Transpose(Application.Transpose(d1.items))
  35. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¤Hªº¤ß¦a¬O¤@²¥¥Ð¡A¤g¦a¨S¦³¼½¤U¦nºØ¤l¡A¤]ªø¤£¥X¦nªºªG¹ê¡C -
ªð¦^¦Cªí ¤W¤@¥DÃD