返回列表 上一主題 發帖

篩選後資料如何複製貼上指定的欄位???

回復 1# p6703
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Range("E2", Range("E2").End(xlDown)).Copy [G2]
  4. End Sub
複製代碼

TOP

回復 3# p6703
試試看
  1. Option Explicit
  2. Sub Ex()
  3.    With Range("E2", Range("E2").End(xlDown))
  4.     .Offset(, 2) = .SpecialCells(xlCellTypeVisible).Value
  5.     End With
  6. End Sub
複製代碼

TOP

回復 5# p6703
修改附檔資料,試試不就知道.

TOP

回復 7# p6703
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, xi As Integer, i As Integer, e As Range
  4.     Set Rng = Range("E2", Range("E2").End(xlDown)).SpecialCells(xlCellTypeVisible)
  5.     'SpecialCells 方法 傳回 Range 物件,此物件代表與指定型態及值相符合的所有儲存格。Range 物件。
  6.     For xi = 1 To Rng.Areas.Count
  7.     'Areas 屬性 定傳回 Areas 集合,此集合代表多重範圍中的所有範圍。唯讀。
  8.         For Each e In Rng.Areas(xi).Cells
  9.             i = i + 1
  10.             If i <= 2 Then  '前2列
  11.                 e.Offset(, 2) = e.Value
  12.             Else
  13.                 e.Offset(, 2) = Rng.Cells(1).Value
  14.             End If
  15.         Next
  16.     Next
  17. End Sub
複製代碼
PS: 回文時  請按 [回覆] 按鈕  答覆你的人才會得到通知, 這是基本的禮貌

TOP

回復 9# p6703
1# 說 :請問以篩選後資料如要複製至指定的欄位
7# 又說 附件重新不規律排序執行巨集,只有前二列於G欄秀出正確的值,第三列開始的值都變成第一列的金額
給你8# 的程式是有依你說撰寫的.
9# 說 但跑出結果仍是只有前二筆會套取正確數據,自第三筆起都是捉取第一筆的數據
那我就不知你的問題是什麼了

TOP

回復 11# p6703
還是不太了解你的說法,試試看是這樣嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     With ActiveSheet.UsedRange
  4.         .Range("A1").AutoFilter 2, "杯子"
  5.         .Columns("E:E").Offset(1).Copy
  6.         .Parent.AutoFilterMode = False   '取消 工作表的自動篩選
  7.         .Range("G:G") = ""
  8.         .Parent.Paste Destination:=.Range("G2")
  9.     End With
  10. End Sub
複製代碼

TOP

回復 13# eg0802
附檔看看

TOP

回復 18# eg0802
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, A As Range, i As Integer, EA As Range
  4.     Set Rng = Range("E2", Range("E2").End(xlDown)).SpecialCells(xlCellTypeVisible)
  5.     'SpecialCells 方法 傳回 Range 物件,此物件代表與指定型態及值相符合的所有儲存格。Range 物件。
  6.     'Areas 屬性 定傳回 Areas 集合,此集合代表多重範圍中的所有範圍。唯讀。
  7.     For Each A In Rng.Areas
  8.         For Each EA In A.Cells
  9.             i = i + 1
  10.             If i <> 2 Then  '<>第2列
  11.                 EA.Offset(, 2) = EA.Value
  12.             End If
  13.         Next
  14.     Next
  15. End Sub
複製代碼

TOP

        靜思自在 : 是非當教育,讚美作警惕。
返回列表 上一主題