標題: [發問] 要將工作表中的特定資料擷取到另一工作表 [打印本頁]

---

作者: marklos    時間: 2015-7-5 22:36     標題: 要將工作表中的特定資料擷取到另一工作表

[attach]21322[/attach]
要將工作表中的特定資料擷取到另一工作表 ,如果不用篩選複製的話 , 巨集指令要如何寫?
[attach]21323[/attach]
[attach]21324[/attach]

---

作者: GBKEE    時間: 2015-7-6 11:09

回復 1# marklos

試試看

1. Option Explicit
   
2. Option Base 1
   
3. 'Option Base 陳述式 在模組層次中用來宣告陣列索引的預設下限。
   
4. '語法
   
5. 'Option Base {0 | 1}
   
6. 'AutoFilter 方法  [自動篩選] 篩選出一個清單。為 Variant
   
7. Sub Ex()
   
8.     Dim Ar, Sh As Worksheet, i As Integer
   
9.     Ar = Array("V:", "I:")
   
10.     Sheets("Sheet1").UsedRange.Clear
    
11.     With Sheets("log")
    
12.         For i = 1 To UBound(Ar)
    
13.             .Range("a1").AutoFilter Field:=1, Criteria1:=Ar(i)
    
14.             .Columns(3).Copy Sheets("Sheet1").Cells(1, i)
    
15.         Next
    
16.         .Range("a1").AutoFilter
    
17.     End With
    
18.     Sheets("Sheet1").[a1].Resize(, UBound(Ar)) = Ar
    
19. End Sub
    
20. Sub Ex1() '不用篩選複製
    
21.     Dim Ar, Ar1(), Ar2(), i As Integer, x As Integer, e As Range
    
22.     Ar = Array("V:", "I:")
    
23.     ReDim Ar1(UBound(Ar))
    
24.     With Sheets("log").Range("A:A")
    
25.         For i = 1 To UBound(Ar)
    
26.             .Replace Ar(i), "=100/0", xlWhole   'Replace 方法
    
27.             '"V:" , "I:" 替換為錯誤值
    
28.             x = 0
    
29.             With .SpecialCells(xlCellTypeFormulas, xlErrors).Cells '錯誤值的儲存格
    
30.                 .Value = Ar(i)              '錯誤值還原為的"V:" , "I:"
    
31.                 ReDim Ar2(.Cells.Count)
    
32.                 For Each e In .Offset(, 2).Cells
    
33.                     x = x + 1
    
34.                     Ar2(x) = e
    
35.                 Next
    
36.                 Ar1(i) = Ar2
    
37.             End With
    
38.         Next
    
39.     End With
    
40.     With Sheets("Sheet1")
    
41.         .UsedRange.Clear
    
42.         For i = 1 To UBound(Ar)
    
43.             .Cells(i) = Ar(i)
    
44.             .Cells(i).Offset(1).Resize(UBound(Ar1(i))) = Application.Transpose(Ar1(i))
    
45.         Next
    
46.     End With
    
47. End Sub

複製代碼

---

作者: marklos    時間: 2015-7-8 21:23

回復 2# GBKEE


    感謝您的幫忙~ 研究研究!
謝謝! 有問題在請教!

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)