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

Åã¥Ü¼Ð°O¸ê®Æ

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-1-12 08:56 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C¤¤ªº°}¦C»P °}¦C»PÀx¦s®æ¹ï·Ó¹B¥Î,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
Sheets(1)¸ê®Æªí:


Sheets(2)°õ¦æµ²ªG:


Option Explicit
Sub TEST()
Dim Brr, i&, j%, R&, xA, xAs
Sheets(2).[A:C].Delete: Brr = Sheets(1).UsedRange
For j = 5 To 17 Step 6
   For i = 4 To UBound(Brr)
      If InStr(Brr(i, j - 1) & Brr(i, j), "¡­") Then
         R = R + 1
         Brr(R, 1) = Sheets(1).Cells(i, j).Item(1, -3).MergeArea(1)
         Brr(R, 2) = Brr(i, j - 3): Brr(R, 3) = Brr(i, j - 2)
      End If
   Next
Next
If R = 0 Then Exit Sub Else xAs = Array([{"¼Ó¼h", "§Ç", "©m¦W"}], Brr)
xA = Array(Sheets(2).[A1].Resize(, 3), Sheets(2).[A2].Resize(R, 3))
For i = 0 To UBound(xA)
      xA(i).Value = xAs(i): xA(i).Borders.LineStyle = 1
      For j = 7 To 10: xA(i).Borders(j).Weight = 4: Next
Next
Application.Goto Sheets(2).[A1]
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¡i¬°µ½Ävª§¡j¤H¥Í­n¬°µ½Ävª§¡A¤À¬í¥²ª§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD