Excel VBA¦p¦ó §Ö³t¨ú®ø¦X¨ÖÀx¦s®æ_ªÅ®æ¶ñ¤J­ì¦X¨Ö­È

Andy2483

½Ð±Ð¦U¦ì«e½ú
¨ú®ø¦X¨ÖÀx¦s®æ«áªºªÅ®æ­n¶ñ¤J­ì¨Ó¦X¨Ö®æªº­È
1.¦³¿ï¨ú°Ê§@·|¤ñ¸ûºC
2.­n«ç¼Ë¤~¯à³v®æ³B²z®É´N¨ú±o¸Ó¦X¨ÖÀx¦s®æªº¦ì§}?
3.¤°»ò¿ìªk¥i¥HÁYµu°õ¦æ®É¶¡

Option Explicit
Sub ¨ú®ø¦X¨ÖÀx¦s®æ_ªÅ®æ¶ñ¤J­ì¦X¨Ö­È()
Dim seL As Range, rnG As Range, T, ad$
T = Timer
Set seL = Cells
For Each rnG In seL.SpecialCells(2)
   If rnG.MergeCells = True Then
      rnG.Select   '¦³³o­Ó°Ê§@·|¤ñ¸ûºC
      ad = Selection.Address
      rnG.MergeCells = False
      Range(ad) = Range(ad).Item(1)
   End If
Next
seL.MergeCells = False'¸É¨ú®ø  ­ì¦X¨Ö®æ´NµL­Èªº°£¦s®æ
MsgBox "¦@¯Ó®É¡G" & Timer - T & " ¬í"
End Sub

n7822123

¦^´_ 1# Andy2483


  ¸Õ¸Õ¬Ý


Sub ¨ú®ø¦X¨ÖÀx¦s®æ_ªÅ®æ¶ñ¤J­ì¦X¨Ö­È_New()
Dim rnG As Range, T, ad$
T = Timer
For Each rnG In Cells.SpecialCells(2)
   If rnG.MergeCells = True Then
      ad = rnG.MergeArea.Address
      With Range(ad)
          .MergeCells = False
          .Value = .Item(1)
      End With
   End If
Next
Cells.MergeCells = False '¸É¨ú®ø  ­ì¦X¨Ö®æ´NµL­Èªº°£¦s®æ
MsgBox "¦@¯Ó®É¡G" & Round(Timer - T, 3) & " ¬í"
End Sub

Andy2483

¦^´_ 2# n7822123


    ÁÂÁ«e½ú«ü¾É
1.´ú¸Õµ²ªG¥i¸`¬Ù«Ü¦h®É¶¡
2.¾Ç²ß¨ìªº­«ÂI:Areaªº·§©À

¹ï«e½ú«Ü©êºp! ³o¶g¦£¤@­Ó­è±µ¨ìªº±M®×,¨S¯à¤Î®É´ú¸Õ¦^À³
ÁÂÁ±z

­ã´£³¡ªL

Dim xR As Range
For Each xR In Cells.SpecialCells(2)
    With xR.MergeArea
         If .Count > 1 Then .UnMerge: .Value = xR.Value
    End With
Next

Andy2483

¦^´_ 4# ­ã´£³¡ªL


    ÁÂÁ«e½ú«ü¾É
²ß±o¤ß±o¦p¤U
1.¦³¨ÇÄݩʬO¥[¤FUn´N¬O¬Û¤Ï,¦³¨Ç¬O=True / False,¦³¨ÇÄݩʨâºØ³£¦³
2.³æ¤@Àx¦s®æ¤]µø¬°MergeArea,¥u¬O Count=1
3.¥©§®ªºÅý©Ò¦³®æ´£¤J¤F .Value = xR.Value
4.³Ìªñ²ß±o¤èªk ½m²ß¦p¤U ½Ð«e½ú¦A«ü¾É

Sub ¦³µù¸Ñªº¦X¨Ö®æ_¨ú®ø¦X¨Ö»P½Æ»s()
Dim uR As Range, com As Comment
For Each com In ActiveSheet.Comments
   Set uR = com.Parent.MergeArea
   With uR
      If .Count > 1 Then
         .UnMerge
         uR.Item(1).Copy uR
      End If
   End With
Next
End Sub