Excel VBA¦p¦ó §Ö³t¨ú®ø¦X¨ÖÀx¦s®æ_ªÅ®æ¶ñ¤Jì¦X¨ÖÈ
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
Excel VBA¦p¦ó §Ö³t¨ú®ø¦X¨ÖÀx¦s®æ_ªÅ®æ¶ñ¤Jì¦X¨ÖÈ
½Ð±Ð¦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 |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 406
- ¥DÃD
- 8
- ºëµØ
- 0
- ¿n¤À
- 453
- ÂI¦W
- 0
- §@·~¨t²Î
- WINDOWS 7
- ³nÅ骩¥»
- 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2015-2-7
- ³Ì«áµn¿ý
- 2021-7-31
|
¦^´_ 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 |
|
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U
|
|
|
|
|
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¦^´_ 2# n7822123
ÁÂÁ«e½ú«ü¾É
1.´ú¸Õµ²ªG¥i¸`¬Ù«Ü¦h®É¶¡
2.¾Ç²ß¨ìªº«ÂI:Areaªº·§©À
¹ï«e½ú«Ü©êºp! ³o¶g¦£¤@Óè±µ¨ìªº±M®×,¨S¯à¤Î®É´ú¸Õ¦^À³
ÁÂÁ±z |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 2833
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2889
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-11-12
|
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 |
|
|
|
|
|
|
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¦^´_ 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 |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|