返回列表 上一主題 發帖

可以請教當欄位不是固定在一個位置我要如何copy到第2活頁

回復 3# hu0318s
  1. Sub ex()
  2. Dim A As Range   'DIM (宣告為私用變數) A  AS(指定變數型態) Range '可參考VBA Range 屬性 的說明
  3. With Sheet1      'With 陳述式 在一個單一物件或一個使用者自訂型態上執行一系列的陳述式
  4.     Set A = .Cells.Find("工令", lookat:=xlWhole)
  5.     'a =>Range  .儲存格中該物件代表所找到的第一個包含所尋找資訊的儲存格(等....
  6.     If Not A Is Nothing Then A.CurrentRegion.Copy Sheet2.[A1]
  7.     'Not A Is Nothing :Not (邏輯否定。返轉, 不是) A Is Nothing(A 是 空的變數) -> 有找到
  8. End With
  9. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 7# hu0318s
請附檔,可了解你所說的問題
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 9# hu0318s
  1. 'End 屬性 傳回 Range 物件,該物件代表包含來源範圍之區域結尾處的儲存格。
  2. '等於按 END+向上鍵、END+向下鍵、END+向左鍵或 END+向右鍵。唯讀 Range 物件。
  3. Sub Ex2()
  4.     Dim A As Range
  5.     With Sheet1
  6.         Set A = .Cells.Find("工令", lookat:=xlWhole)
  7.         If Not A Is Nothing Then
  8.              .Range(A, A.End(xlDown)).Copy Sheet3.[A1]
  9.         End If
  10.         Set A = .Cells.Find("品名", lookat:=xlWhole)
  11.         If Not A Is Nothing Then
  12.              .Range(A, A.End(xlDown)).Copy Sheet3.[B1]
  13.         End If
  14.     End With
  15. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 11# ML089
  1. Option Base 1
  2. Sub Ex()
  3.     Dim AR(), i As Integer, A As Range
  4.     AR = Array("工令", "品名", "MRP料齊日")
  5.     With Sheet1
  6.         For i = 1 To UBound(AR)
  7.             Set A = .Cells.Find(AR(i), lookat:=xlWhole)
  8.             If Not A Is Nothing Then .Range(A, A.End(xlDown)).Copy Sheet3.Cells(1, i)
  9.         Next
  10.     End With
  11. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2013-12-1 16:35 編輯

回復 15# hu0318s
  1. Option Base 1
  2. Sub Ex()
  3.     Dim AR(), i As Integer, A As Range
  4.      AR = Array("工令", "品名", "MRP料齊日")
  5.     With Workbooks.Open(Filename:="C:\book1.xls") '檢查看看 C:有book1.xls嗎?
  6.         For i = 1 To UBound(AR)
  7.             Set A = .Worksheets("sheet1").Cells.Find(AR(i), lookat:=xlWhole)
  8.             If Not A Is Nothing Then .Worksheets("sheet1").Range(A, A.End(xlDown)).Copy Workbooks("book2.xls").Worksheets("Sheet3").Cells(1, i)
  9.             '如這程式碼是Workbooks("book2.xls")專案的程式碼
  10.             'If Not A Is Nothing Then .Worksheets("sheet1").Range(A, A.End(xlDown)).Copy Sheet3.Cells(1, i)
  11.             'Sheet3 是工作表物件的名稱 無法用Workbooks("book2.xls").Sheet3
  12.             '需是Workbooks("book2.xls").Worksheets("工作表名稱")
  13.         Next
  14.         .Close False
  15.     End With
  16. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 18# hu0318s

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 21# hu0318s
SpecialCells 方法   傳回 Range 物件,此物件代表與指定型態及值相符合的所有儲存格。Range 物件。
EntireColumn 屬性 傳回 Range 物件,該物件代表包含該指定範圍的整個欄 (或若干欄)。
Areas 屬性         傳回 Areas 集合,此集合代表多重範圍中的所有範圍。
  1. Option Base 1
  2. Sub Ex2()
  3.     Dim ar(), i As Integer, a As Range
  4.     Sheet2.[a:x].Clear
  5.     ar = Array("T1", "T2", "t3")
  6.     With Workbooks.Open(Filename:="C:\123.xls")
  7.         For i = 1 To UBound(ar)
  8.             Set a = .Worksheets("data").Cells.Find(ar(i), lookat:=xlWhole)
  9.             If Not a Is Nothing Then a.EntireColumn.SpecialCells(xlCellTypeConstants).Copy Worksheets(2).Cells(1, i)
  10.         Next
  11.        .Close False
  12.     End With
  13. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 23# hu0318s
不必捨近求遠

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 【時日莫空過】一個人在世間做了多少事,就等於壽命有多長。因此必須與時間競爭,切莫使時日空過。
返回列表 上一主題