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

[µo°Ý] 5000¦C 3¬í! ÁÙ¥i¥H§ó§Ö¶Ü? (¨Ì±ø¥ó±a­È¨Ã¤W©³¦â)

[µo°Ý] 5000¦C 3¬í! ÁÙ¥i¥H§ó§Ö¶Ü? (¨Ì±ø¥ó±a­È¨Ã¤W©³¦â)

¦U¦ì«e½ú¦n
¦]¬°½d¨Ò»P¥Øªºµ²ªG¤£¦P!©Ò¥H¥t¶}¥DÃD½Ð±Ð¦U¦ì«e½ú
«á¾Ç·Q´£¤É³B¸ÌÀx¦s®æ®æ¦¡ªº®Ä¯à!½Ð¦U¦ì«e½ú«ü¾É
1.«á¾Ç¥H©¹³£¬O¥HÀx¦s®æ©Î¾ãÄæ.¾ã¦Cªº¤è¦¡,¦b¦U¤u§@ªí©Î¸óÀɮ׳B²z¸ê®Æ,³Ì«á³s¦P®æ¦¡¤@°_COPY¨ì¥Øªº¦a
2.¾Ç²ß°}¦C»P¦r¨å«á ·Q±N¸ê®Æ­Ë¤J°}¦C³B²z«á¦b¥Øªº¦a¶K¤W­È!³o¼Ë®Ä²v´£¤É«Ü¦h!
3.¦ý¬O²¦³º¦³¨ÇÀx¦s®æ»Ý­n§ïÅܮ榡(¤W©³¦â.²ÊÅé...),¤£ª¾¹D¥Î¤°»ò¤è¦¡¥i¥H§ó§Ö³]©w®æ¦¡?
4.¶X»s§@½d¨Ò®É½m²ß¥¿«h

Àµ½Ð«e½ú­Ì«üÂI!ÁÂÁÂ
¨Ì±ø¥ó±a­È¨Ã¤W©³¦â_20221104_2.zip (422.28 KB)

­ìªÅµ²ªGªí:


¸ê®Æªí:


°õ¦æ«áµ²ªGªí:


µ{¦¡½X¦p¤U:
Option Explicit
Sub ¤Ï¦V±a­È_¤W¦â_TEST()
Dim Arr, R&, C%, Sh, Shu, reg, Find_Num, i&
Dim x%, y%, x1%, j%, T
T = Timer
Set Sh = Sheets("¾Þ§@ªí")
Set Shu = Sheets("¤Ï¾Þ§@ªí")
R = Shu.UsedRange.EntireRow.Rows.Count
C = Shu.UsedRange.EntireColumn.Columns.Count
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = "\d+"
reg.Global = True
For x = 2 To C Step 2
   For y = 3 To R
      Set Find_Num = reg.Execute(Shu.Cells(y, x))
      If Find_Num.Count > 0 Then
         Sh.Cells(Find_Num(0), Find_Num(1)).Interior.ColorIndex = _
         Shu.Cells(1, x + 1).Interior.ColorIndex
         Sh.Cells(Find_Num(0), Find_Num(1)) = Shu.Cells(y, x + 1)
      End If
   Next
Next
Sh.Activate
MsgBox Timer - T & " ’"
End Sub

ÁÂÁ¦U¦ì«e½ú
'Âà©À!
'1.±q¸ê®Æ®w¸Ì±a¥X»Ý­nªº¸ê®Æ¬d¬Ý©Î´N¥i¥H¤F!
'¤£¥²­n¸ê®Æ®w¥þ³¡±a¥X¸ê®Æ¤W¤F©³¦â,¦A¿z¿ï»Ý­nªº¸ê®Æ
'2.¬°¤F¬d¬Ý¨Ï¥Î¦Ó¤W¦â!¨S¦³¥²­n¬°¤W¦â¦Ó¤W¦â
'3.¦Ü©ó¦pªG¬O¬°¤F½s¿è¸ê®Æ,¦Ó¥u±a¥X¸ê®Æ®w¤Ö³¡¤À¸ê®Æ!
'´N½m¦n§Þ¯à,«ö­Ó¶s±N¦³½s¿èªº¸ê®Æ§Ö³t¤Ï±a¦^¸ê®Æ®w´N¦n¤F


¥H¤U¤ß±oµù¸Ñ½Ð¦U¦ì«e½ú«ü¥¿¨Ã«ü¾É!ÁÂÁÂ
Option Explicit
Sub ¤Ï¦V±a­È_¤W¦â_Detail()
Dim Arr, R&, C%, Sh, Shu, reg, Find_Num, i&
Dim x%, y%, Z&, T
'¡ô«Å§iÅܼÆ
T = Timer
Z = 200
'¡ô³]©w·Q­n¬d¬Ý¸ê®Æªº²Ó³¡±ø¥ó
Set Sh = Sheets("¾Þ§@ªí")
'¡ô¥OSh ¬O¤u§@ªí
Set Shu = Sheets("¤Ï¾Þ§@ªí")
'¡ô¥OShu ¬O¤u§@ªí
Sh.UsedRange.EntireRow.Delete
'¡ô¾Þ§@ªí ¦³¨Ï¥Îªº¦C¥þ³¡§R°£
R = Shu.UsedRange.EntireRow.Rows.Count
'¡ô¥OR¬O ¤Ï¾Þ§@ªí¦³¨Ï¥Îªº¦C¼Æ
C = Shu.UsedRange.EntireColumn.Columns.Count
'¡ô¥OC¬O ¤Ï¾Þ§@ªí¦³¨Ï¥ÎªºÄæ¼Æ
Set reg = CreateObject("VBScript.RegExp")
'¡ô¥Oreg ¬O¥¿«h
reg.Pattern = "\d+"
'¡ô¥¿«hªº³W«h¬O³Q«D¼Æ¦r¶¡¹jªº¼Æ¦r¦ê
reg.Global = True
'¡ô¥¿«h«áªº¸ê®Æ¥þ³¡³£­n!
For x = 2 To C Step 2
'¡ô³]¥~¶¶°j°é! ±q2 ¨ì ¤Ï¾Þ§@ªí¦³¨Ï¥ÎªºÄæ¼Æ,¨C¦¸Â¶¦^¨Óx+2
   For y = 3 To R
   '¡ô³]¤º¶¶°j°é! ±q2 ¨ì ¤Ï¾Þ§@ªí¦³¨Ï¥Îªº¦C¼Æ
      Set Find_Num = reg.Execute(Shu.Cells(y, x))
      '¡ô¥OFind_Num ¬O°j°éÀx¦s®æ°õ¦æ¥¿«h¤§«áªº°}¦C
      If Find_Num.Count > 0 Then
      '¡ô¦pªG Find_Num°}¦C¸Ì¦³¸ê®Æ??
         If Find_Num(0) Mod Z = 0 Then
         '¡ô¦pªG Find_Num°}¦C¸Ìªº²Ä­Ó¼Æ¦r °£¥H200ªº¾l¼Æ¬O0(¾ã°£ªº·N«ä)
            Sh.Cells(Find_Num(0) / Z, Find_Num(1)).Interior.ColorIndex = _
            Shu.Cells(1, x + 1).Interior.ColorIndex
            '¡ô¾Þ§@ªí¬Û¹ïÀ³ªºÀx¦s®æ¦ì¸m¤W©³¦â
            Sh.Cells(Find_Num(0) / Z, Find_Num(1)) = Shu.Cells(y, x + 1)
            '¡ô¾Þ§@ªí¬Û¹ïÀ³ªºÀx¦s®æ¦ì¸m¿é¤J­È
         End If
      End If
   Next
Next
Sh.Activate
MsgBox Timer - T & " ’"
End Sub

TOP

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