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

[µo°Ý] ¦p¦ó¨Ï¥Î°Ñ·Ó­¶¨Ó¨ú¥N¯S©w¦r¦ê

[µo°Ý] ¦p¦ó¨Ï¥Î°Ñ·Ó­¶¨Ó¨ú¥N¯S©w¦r¦ê

½Ð°Ý¦p¦ó§ó§Ö³t¨Ï¥Î°Ñ·Ó­¶¨Ó¨ú¥N¯S©w¦r¦ê

§Æ±æ³z¹L "¤H­û½s¸¹"¹ï·Ó"½s¸¹"¨Ó¨ú¥N,¹F¨ì"¤H¦W¹ï·Ó"®ÄªG

¥Ø«e¨Ï¥Îªº¨ú¥N¤è¦¡¬°
Worksheets("¤H­û½s¸¹").Columns("B").Replace _
What:="D00024", Replacement:="¨ª²Q­^", _
SearchOrder:=xlByColumns, MatchCase:=True

µ¥©ó­n¨C­Ó½s¸¹³£¶·«Ø¥ß¨ú¥N
½Ð°Ý¯à§_¦³§ó¦³®Ä²v¹F¨ì½d¨Ò¸Ìªº®ÄªG?

TEST.zip (9.99 KB)

Andy2483¤j §ïªº¹ÎÁÊ©ú²Ó¤]«Ü¹ê¥Î¡A¥ý°O¤U¤F~

TOP

½Ð°Ýhcm19522¤j,³o¬q¨ç¼Æ§@¥Î¬°¦ó?§Ú±a¤Jªí¤¤¥X²{¿ù»~...

TOP

B2{=IF(¤H­û½s¸¹!B2="","",INDIRECT("½s¸¹!"&TEXT(MAX((½s¸¹!$B$1:$H$26=¤H­û½s¸¹!B2)*ROW($1:$26)/1%+COLUMN($A:$G)),"!R0C00"),))
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«¥H¸ê®Æªí½m²ß¦X¨ÖÀx¦s®æ§P©w»P°}¦C°µ¥X¹ÎÁÊ©ú²Ó¨Ã³]©w¦C¦L½d³ò,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
¸ê®Æªí:


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


Option Explicit
Sub TEST_20240328_1()
Dim xR As Range, Brr, i%, j%, T$, Crr, R%
ReDim Crr(1 To 1000, 1 To 6)
With Sheets("½s¸¹")
   Brr = .UsedRange
   For j = 1 To UBound(Brr, 2) Step 3
      For i = 1 To UBound(Brr)
         Set xR = .Cells(i, j): If xR.MergeArea.Cells.Count = 2 And xR <> "" And xR <> T Then T = xR: GoTo i01
         R = R + 1: Crr(R, 1) = R: Crr(R, 2) = T: Crr(R, 3) = Brr(i, j): Crr(R, 4) = Brr(i, j + 1)
i01:  Next
   Next
End With
Workbooks.Add: [A1].Resize(, 6) = [{"NO.","¾ºÙ","©m¦W","¤H­û½s¸¹","¹ÎÁÊ©ú²Ó","Á`ª÷ÃB"}]
With [A2].Resize(R, 6)
   .Value = Crr
   .Columns(5).ColumnWidth = 25
   .Borders.LineStyle = 1
   Range([A1], .Cells).Name = "'" & ActiveSheet.Name & "'!Print_Area"
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

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

Option Explicit
Sub TEST()
Dim Z, xR As Range
'¡ô«Å§iÅܼÆ:xRÅܼƬOÀx¦s®æÅܼÆ,Z¬O³q¥ÎÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
For Each xR In Sheets("½s¸¹").Cells.SpecialCells(2)
'¡ô³]³v¶µ°j°é!¥OxRÅܼƬO ¤u§@ªí¸Ìªº«DªÅ®æÀx¦s®æ
   If xR Like "[A-Z]#####" Then Z(xR.Value) = xR(1, 0)
   '¡ô¦pªGxRÅܼƭÈÃþ«¬¬O ¤j¼g­^¤å¦r¶}ÀY¦A³s±µ5½X¼Æ¦r©Ò²Õ¦¨ªº¦r¦ê?
   'True´N¥O¤wxRÅܼƭȬ°key,item¬OxRÅܼƥª°¼Àx¦s®æ­È,¯Ç¤JZ¦r¨å

Next
Sheets("¤H¦W¹ï·Ó").UsedRange.Offset(1).EntireRow.Delete
'¡ô¥O¸ê®Æ§R°£
Sheets("¤H­û½s¸¹").UsedRange.Offset(1).Copy [¤H¦W¹ï·Ó!A2]
'¡ô¥O¸ê®Æ½Æ»s¨ìµ²ªGªí
For Each xR In Sheets("¤H¦W¹ï·Ó").Cells.SpecialCells(2)
'¡ô³]³v¶µ°j°é!¥OxRÅܼƬO ¤u§@ªí¸Ìªº«DªÅ®æÀx¦s®æ
   If Z.Exists(xR.Value) Then xR = Z(xR.Value)
   '¡ô¦pªGZ¦r¨å¸Ì¦³ xRÅܼƭÈ?´N¥OxRÅܼƭȬO ¥HxRÅܼƭȬdZ¦r¨å¦^¶Çitem­È
Next
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

·PÁÂAndy¤jªº¸Ñµª¡A¹ê´ú¨S°ÝÃD~
¾ã­Ó¶Wºë²¡A¤ÓÁÂÁ±z¤F¡C

TOP

¦^´_ 1# GGGYYY


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß¦r¨å»P SpecialCells(),¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Z, xR As Range
Set Z = CreateObject("Scripting.Dictionary")
For Each xR In Sheets("½s¸¹").Cells.SpecialCells(2)
   If xR Like "[A-Z]#####" Then Z(xR.Value) = xR(1, 0)
Next
Sheets("¤H¦W¹ï·Ó").UsedRange.Offset(1).EntireRow.Delete
Sheets("¤H­û½s¸¹").UsedRange.Offset(1).Copy [¤H¦W¹ï·Ó!A2]
For Each xR In Sheets("¤H¦W¹ï·Ó").Cells.SpecialCells(2)
   If Z.Exists(xR.Value) Then xR = Z(xR.Value)
Next
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ±o²z­nÄǤH¡A²zª½­n®ð©M¡C
ªð¦^¦Cªí ¤W¤@¥DÃD