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

[µo°Ý] ½Ð°Ý¯à§_¥ÎVBA©Î¨ç¼Æ¦P®É§¹¦¨Äæ¦ì´M§ä+¤ñ¸û¤j¤p?

[µo°Ý] ½Ð°Ý¯à§_¥ÎVBA©Î¨ç¼Æ¦P®É§¹¦¨Äæ¦ì´M§ä+¤ñ¸û¤j¤p?

¥»©«³Ì«á¥Ñ GGGYYY ©ó 2024-3-14 16:30 ½s¿è

½Ð°Ý¯à§_¥ÎVBA©Î¨ç¼Æ¦P®É§¹¦¨Äæ¦ì´M§ä+¤ñ¸û¤j¤p°ÝÃD?

¥Ñ"°Ñ·Ó¼Æ­È"§ä´M"¤é´Áªí"¤º(H)Äæ¦ì¬O§_¦³¬Û¦P­È¡A¨Ã¤ñ¸û(O)Äæ¦ì¤j¤p¬D¿ï³Ì¤j­Èªº¦C¦ì½Æ»s¨ì"´£¨ú¸ê®Æ"ªí¤º¡C
°Ñ·Ó¼Æ­È·|«D©T©w­È¡A·|¨Ì»Ý¨D§ó§ï¡AµL§ä¤£¨ì­È¡A«hNA±a¤J
¥Ø«e³z¹L±Æ§Ç¤ñ¸û¤j¤p¡A§R°£¼Æ­È¤pªº«á¡A¦A³z¹L¨ç¼Æ¨ó§U³B²z¡A¦ý¸ê®Æ¤@¦hÁÙ¬O¦³ÂI¶O®É¡C
½Ð°Ý¯à§_´£¨Ñ¤ñ¸û¦nªº¤èªk¨Ñ°Ñ¦Ò?

ªþ¤W½d¨Ò¥Ü·NÀÉ
BOOK_TEST.zip (7.82 KB)

¦^´_ 1# GGGYYY

ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C.Evaluate()»P ¥H¦r¨å°O¿ý¦C¸¹ªº¤èªk,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
°õ¦æµ²ªG:


Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, i&, j%, R&, T$, TT$, xS As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
Brr = [¤é´Á!A1].CurrentRegion: Set xS = Sheets("´£¨ú¸ê®Æ"): xS.UsedRange.Offset(1).EntireRow.Delete
For i = 2 To UBound(Brr)
   T = Brr(i, 8): V = Brr(i, 15): TT = i & "^0*" & Val(V)
   If Not Z.EXISTS(T) Then Z(T) = TT Else Z(T) = IIf(Val(V) > Evaluate(Z(T)), TT, Z(T))
Next
ReDim Arr(1 To UBound(Brr), 1 To UBound(Brr, 2)): Crr = [°Ñ·Ó¼Æ­È!A1].CurrentRegion
For i = 2 To UBound(Crr)
   T = Crr(i, 1): Crr(i, 1) = ""
   If Not Z.EXISTS(T) Then
      Arr(i - 1, 1) = "NA": Crr(i, 1) = "NA": Arr(i - 1, 8) = T
      Else
      R = Split(Z(T), "^")(0): For j = 1 To UBound(Brr): Arr(i - 1, j) = Brr(R, j): Next
   End If
Next
With Sheets("°Ñ·Ó¼Æ­È")
   .UsedRange.Offset(, 1).EntireColumn.Delete
   .[B1].Resize(UBound(Crr)) = Crr: .[B1] = "NAµù°O"
End With
With xS.[A2].Resize(UBound(Crr) - 1, UBound(Arr, 2))
   .Value = Arr: Application.Goto xS.[A1]
   .Columns(2).NumberFormat = "hh:mm:ss"
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

(·j´M½s¸¹12528) googleºô§}:https://hcm19522.blogspot.com/
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-3-19 08:13 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C.Large()»P¦r¨å°O¿ý¦C¸¹,¾Ç²ß¦C¥X"¤é´Á"ªíOÄæ«e10¤j­È¸ê®Æ¦C
°õ¦æµ²ªG:


Option Explicit
Sub TEST_1()
Dim Arr, Brr, V, Q, Z, i&, j%, N&, a%, xS As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
Brr = [¤é´Á!A1].CurrentRegion: Set xS = Sheets("´£¨ú¸ê®Æ"): xS.UsedRange.Offset(1).EntireRow.Delete
For i = 2 To UBound(Brr)
   V = Brr(i, 15): V = Val(V)
   If Not Z.EXISTS(V) Then Z(V) = i Else Z(V) = Z(V) & "/" & i
Next
ReDim Arr(1 To UBound(Brr), 1 To UBound(Brr, 2) + 1)
For i = 1 To 10
   Q = Application.Large(Z.keys, i)
   V = Split("/" & Z(Q), "/")
   For a = 1 To UBound(V)
      N = N + 1: Arr(N, 1) = i: For j = 1 To UBound(Brr, 2): Arr(N, j + 1) = Brr(Val(V(a)), j): Next
   Next
Next
With xS.[A2].Resize(N, UBound(Arr, 2))
   .Value = Arr: Application.Goto xS.[A1]: .Columns(3).NumberFormat = "hh:mm:ss"
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

·PÁÂAndy¤jªºÀ°¦£¡A¹ê´ú«á §¹¥þ²Å¦X»Ý¨D~
ÁپǨ줣¥Î³z¹L±Æ§Ç¤è¦¡´N¯à§Ö³t§ä¥X³Ì¤j­È¤è¦¡~
¤Ó·PÁ±z¤F~

TOP

hcm19522¤jªº¨ç¼Æ³¡¤À ¤]¤£¿ù¥Î¡A¾Ç²ß¤F~
¤Ó·PÁ¤F!!!

TOP

Andy¤j,µo²{¤@­Ó¤p°ÝÃD¡A·í¨Ó·½¸ê®Æ¤j©ó59µ§®É¡A¹B¦æ·|¥X²{¿ù»~
¬O°}¦C³¡¤Àªº°ÝÃD¶Ü?

TOP

¦^´_ 7# GGGYYY

ÁÂÁ«e½ú¦^´_
«á¾Ç½k¶î,½Ð­×§ï¦p¤U¸Õ¸Õ¬Ý:
R = Split(Z(T), "^")(0): For j = 1 To UBound(Brr, 2): Arr(i - 1, j) = Brr(R, j): Next
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦A¦¸·PÁÂAndy¤j¡A¹ê´ú¥i¥¿±`¹B¦æ¤F~

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½Æ²ß­×­q,¾Ç²ß¤ß±o¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, i&, j%, R&, T$, TT$, xS As Worksheet
'¡ô«Å§iÅܼÆ:&¬Oªø¾ã¼Æ,$¬O¦r¦êÅܼÆ,%¬Oµu¾ã¼Æ,¨S¦³«ü©wªº¬O³q¥Î«¬ÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Brr = [¤é´Á!A1].CurrentRegion: Set xS = Sheets("´£¨ú¸ê®Æ"): xS.UsedRange.Offset(1).EntireRow.Delete
'¡ô¥OBrrÅܼƬO ¥H¤u§@ªíÀx¦s®æ­È±a¤Jªº¤Gºû°}¦C,¥OxSÅܼƬO(ª«¥ó)"´£¨ú¸ê®Æ"¤u§@ªí
'¥O¸ê®Æ§R°£,¥u¯d¤U¼ÐÃD¦C

For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   T = Brr(i, 8): V = Brr(i, 15): TT = i & "^0*" & Val(V)
   '¡ô¥OTÅܼƬOi°j°é¦C8ÄæBrr°}¦C­È,¥OVÅܼƬOi°j°é¦C15ÄæBrr°}¦C­È
   '¥OTTÅܼƬO°j°é¼Æi ³s±µ"^0*"¦r¦ê,¦A³s±µVÅܼÆÂà¼Æ­È©Ò²Õ¦¨ªº·s¦r¦ê

   If Not Z.EXISTS(T) Then Z(T) = TT Else Z(T) = IIf(Val(V) > Evaluate(Z(T)), TT, Z(T))
   '¡ô¦pªGZ¦r¨å¸Ì¨S¦³TÅܼÆkey!´N¥O¥HT¬°key,item¬OTTÅܼƯǤJZ¦r¨å¤¤,
   '§_«h´N¥O¥HT¬°key,item¬OIIf()¦^¶Ç­È

Next
ReDim Arr(1 To UBound(Brr), 1 To UBound(Brr, 2)): Crr = [°Ñ·Ó¼Æ­È!A1].CurrentRegion
'¡ô«Å§iArrÅܼƬO¤GºûªÅ°}¦C,«Å§i¨ä°}¦C½d³ò,¥OCrr°}¦C¬O ¥H¤u§@ªíÀx¦s®æ­È±a¤Jªº¤Gºû°}¦C
For i = 2 To UBound(Crr)
'¡ô³]¶¶°j°é!i±q2 ¨ìCrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   T = Crr(i, 1): Crr(i, 1) = ""
   '¡ô¥OTÅܼƬOi°j°é¦C1ÄæCrr°}¦C­È,¥Oi°j°é¦C1ÄæCrr°}¦C­È¬OªÅ¦r¤¸
   If Not Z.EXISTS(T) Then
   '¡ô¦pªGZ¦r¨å¸Ì¨S¦³TÅܼÆkey??
      Arr(i - 1, 1) = "NA": Crr(i, 1) = "NA": Arr(i - 1, 8) = T
      '¡ô¥O§ä¤£¨ìÃöÁä¦r¦Cµù°OÄæ¼g¤J"NA"¦r¦ê
      Else
      R = Split(Z(T), "^")(0): For j = 1 To UBound(Brr, 2): Arr(i - 1, j) = Brr(R, j): Next
      '¡ô¥ORÅܼƬO Z¦r¨å°O¿ýªº¦C¸¹!³]¶¶°j°é±NBrr¸ê®Æ¼g¤JArr°}¦C¸Ì
   End If
Next
With Sheets("°Ñ·Ó¼Æ­È")
   .UsedRange.Offset(, 1).EntireColumn.Delete
   '¡ô¥O"°Ñ·Ó¼Æ­È"ªí¥u¯d¤U¼ÐÃDÄæ,¨ä¾lÄæ¦ì§R°£
   .[B1].Resize(UBound(Crr)) = Crr: .[B1] = "NAµù°O"
   '¡ô¥OBÄæ¼g¤J"NA"µù°O
End With
With xS.[A2].Resize(UBound(Crr) - 1, UBound(Arr, 2))
'¡ô¥H¤U¬OÃö©ó"´£¨ú¸ê®Æ"ªí±q[A2]Àx¦s®æÂX®i«ü©w½d³òÀx¦s®æªºµ{§Ç
   .Value = Arr: Application.Goto xS.[A1]
   '¡ô¥OArr°}¦C­È¼g¤J "´£¨ú¸ê®Æ"ªí,¥O´å¼Ð¸õ¨ì"´£¨ú¸ê®Æ"ªí[A1]Àx¦s®æ
   .Columns(2).NumberFormat = "hh:mm:ss"
   '¡ô¥O¸Ó½d³ò²Ä2Äæ®æ¦¡¬°2½X®É:¤À:¬í
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : °µ¦n¨Æ¤£¯à¤Ö§Ú¤@¤H¡A°µÃa¨Æ¤£¯à¦h§Ú¤@¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD