返回列表 上一主題 發帖

[發問] 有關刪除線文字搬移請教

回復 1# macro0029
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh As Worksheet, E As Range, Rng As Range
  4.     For Each Sh In Sheets(Array("SHEET1", "SHEET2"))
  5.         Set Rng = Nothing
  6.         For Each E In Sh.UsedRange
  7.             If E <> "" And E.Font.Strikethrough = True Then
  8.                 If Rng Is Nothing Then
  9.                     Set Rng = E
  10.                 Else
  11.                 Debug.Print Rng.Address
  12.                     Set Rng = Union(Rng, E)
  13.                 End If
  14.             End If
  15.         Next
  16.         If Not Rng Is Nothing Then
  17.             Rng.EntireRow.Copy Sheets("SHEET3").Range("A" & Rows.Count).End(xlUp).Offset(1)
  18.         End If
  19.     Next
  20. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 人要自愛,才能愛普天下的人。
返回列表 上一主題