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

[µo°Ý] ¸Ó¦p¦ó¬Y¨Ç±ø¥ó¥²¶·²Å¦X¡A¬Y¤@±ø¥ó¥i¼Ò½k¤ñ¹ï¡H

[µo°Ý] ¸Ó¦p¦ó¬Y¨Ç±ø¥ó¥²¶·²Å¦X¡A¬Y¤@±ø¥ó¥i¼Ò½k¤ñ¹ï¡H

¥»©«³Ì«á¥Ñ tsoo811024 ©ó 2020-8-19 14:45 ½s¿è

¤p§Ì¸I¨ì¤@­Ó°ÝÃD¡A¸Ó¦p¦ó°Ï¡B¨½¡B¸ô(µó)¡B§Ë¡B«Ñ¦P®É²Å¦X¡AªùµP¸¹ºÉ¶q²Å¦X¦a¥h§ì¨ú¤wª¾®y¼Ð­È?

¨Ò¦p:¯Q¤é°Ï¥ú©ú¨½¥ú©ú¸ô152¸¹¡A¦]¥u¦³¯Q¤é°Ï¥ú©ú¨½¥ú©ú¸ô149¸¹¡B¯Q¤é°Ï¥ú©ú¨½¥ú©ú¸ô153¸¹¤§¤wª¾®y¼Ð­È
¯à§_¤ñ¹ï«á§ì¨ú¯Q¤é°Ï¥ú©ú¨½¥ú©ú¸ô153¸¹(³Ì¬Ûªñ¤§ªùµP)·í§@152¸¹¤§®y¼Ð­È¡A¨Ã¼Ðµù¬°¼Ò½k¤ñ¹ï...

¦]½×¾Âªþ¥ó¤W­­¢°MB¡A¨S¿ìªk¤W¶Ç¡A¬G¥Îgoogle¶³ºÝ¤W¶Ç~¦³³Ò¤j¯«½ç±Ð...
https://drive.google.com/file/d/1cUDCHfHE_Pkv9r3bHd2-u6g7Dgc7O_nt/view?usp=sharing

·PıÆZ½ÆÂø:
  1. Sub zz()
  2. Dim a, b, c(), n&, d As Object, re As Object, aa(), xt As Boolean
  3. Dim dd As Object, s$, p, z(1)
  4. Set re = CreateObject("vbscript.regexp")
  5. Set d = CreateObject("scripting.dictionary")
  6. Set dd = CreateObject("scripting.dictionary")
  7. With Sheets(2)
  8.     a = .Range("b2:i" & .[b1048576].End(3).Row)
  9. End With
  10. Application.StatusBar = "Program processing... please wait"
  11. With re
  12.     .Pattern = "(\d+-?\d*)"
  13.     .Global = True
  14.     For i = 1 To UBound(a)
  15.         d(a(i, 1)) = i
  16.         If .test(a(i, 1)) Then
  17.             k = Split(.Replace(a(i, 1), "|$1|"), "|")
  18.             n = Val(k(UBound(k) - 1))
  19.             s = ""
  20.             For j = 0 To UBound(k) - 2 Step 2
  21.                 s = s & k(j)
  22.             Next
  23.             If dd.exists(s) Then
  24.                 p = dd(s)
  25.                 ReDim Preserve p(UBound(p) + 1)
  26.                 p(UBound(p)) = n & "|" & i
  27.                 dd(s) = p
  28.             Else
  29.                 dd(s) = Array(n & "|" & i)
  30.             End If
  31.         End If
  32.     Next
  33. End With
  34. For Each k In dd.keys
  35.     p = dd(k)
  36.     ReDim b(UBound(p), 1)
  37.     For j = 0 To UBound(p)
  38.         t = Split(p(j), "|")
  39.         b(j, 0) = Val(t(0))
  40.         b(j, 1) = Val(t(1))
  41.     Next
  42.     For i = 0 To UBound(b) - 1
  43.         t = b(i, 0)
  44.         For j = i + 1 To UBound(b)
  45.             If b(j, 0) < t Then t = b(j, 0): jj = j: xt = True
  46.         Next
  47.         If xt Then
  48.             xt = False
  49.             For j = 0 To 1
  50.                 z(j) = b(i, j)
  51.                 b(i, j) = b(jj, j)
  52.                 b(jj, j) = z(j)
  53.             Next
  54.         End If
  55.     Next
  56.     dd(k) = b
  57. Next
  58. With Sheets(1)
  59.     b = .Range("b2:b" & .[b1048576].End(3).Row)
  60.     .Cells(2, "h").Resize(UBound(b), 3).Clear
  61.     ReDim c(1 To UBound(b), 1 To 3)
  62.     For i = 1 To UBound(b)
  63.         Application.StatusBar = "Finised " & i & " of " & UBound(b)
  64.             n = d(b(i, 1))
  65.             If n Then
  66.                 c(i, 1) = a(n, 7): c(i, 2) = a(n, 8)
  67.             Else
  68.                 c(i, 3) = "¼Ò½k¤ñ¹ï"
  69.                 GoSub FC
  70.                 If dd.exists(s) Then
  71.                     p = dd(s)
  72.                     If n Then
  73.                         If UBound(p) Then
  74.                             If n < p(0, 0) Then n = p(0, 0)
  75.                             n = Application.VLookup(n, dd(s), 2, 1)
  76.                         Else
  77.                             n = dd(s)(0, 1)
  78.                         End If
  79.                         c(i, 1) = a(n, 7): c(i, 2) = a(n, 8)
  80.                     End If
  81.                 End If
  82.             End If
  83.         Next
  84.     Cells(2, "H").Resize(i - 1, 3) = c
  85. End With
  86. Debug.Print dd.Count
  87. Application.StatusBar = False
  88. End
  89. FC:
  90. With re
  91.         If .test(b(i, 1)) Then
  92.             k = Split(.Replace(b(i, 1), "|$1|"), "|")
  93.             n = Val(k(UBound(k) - 1))
  94.             s = ""
  95.             For j = 0 To UBound(k) - 2 Step 2
  96.                 s = s & k(j)
  97.             Next
  98.         End If
  99. End With
  100. Return
  101. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¨S¦³©Ò¦³Åv¡A¥u¦³¥Í©Rªº¨Ï¥ÎÅv¡C
ªð¦^¦Cªí ¤W¤@¥DÃD