返回列表 上一主題 發帖

請問欄位複製的問題

tonycho33

帖子
102 
主題
30 
精華
0 
積分
137 
點名
0  
作業系統
winxp 
軟體版本
12 
閱讀權限
20 
性別
男 
註冊時間
2011-11-24 
最後登錄
2018-12-6 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-3-22 11:43 | 只看該作者

請問欄位複製的問題

本帖最後由 tonycho33 於 2012-3-22 11:45 編輯

請問欄位複製的問題
請問目前有3個sheet分別是aa1,aa2,aa3
我想把aa3的sheet的Y欄copy到aa1的A欄，
但是有條件就是
1.aa3的Y欄空格要刪除
2.aa3的AA欄有出現"已排"也要刪除
3.aa3的Y欄到AA欄是套公式進來的
之前的作法是新增一個sheet--aa2，先在這邊作錄製巨集的篩選
然後再轉到aa1
請問有更簡潔的寫法嗎
謝謝
之前的巨集如下
  1. Sheets("aa3").Select
  2.    Columns("Y:AA").Select
  3.     Selection.Copy
  4.     Sheets("aa2").Select
  5.     Columns("F:F").Select
  6.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  7.         :=False, Transpose:=False
  8.     Cells.Select
  9.     Selection.AutoFilter
  10.     Selection.AutoFilter
  11.     Selection.AutoFilter Field:=6, Criteria1:="="
  12.     Rows("2:2").Select
  13.     Range(Selection, Selection.End(xlDown)).Select
  14.     Selection.Delete Shift:=xlUp
  15.     Selection.AutoFilter Field:=6
  16.     Selection.AutoFilter Field:=8, Criteria1:="已排"
  17.     Rows("4:4").Select
  18.     Range(Selection, Selection.End(xlDown)).Select
  19.     Selection.Delete Shift:=xlUp
  20.     Selection.AutoFilter Field:=8
  21.     Cells.Select
  22.     Selection.AutoFilter
  23.     Sheets("aa1").Select
複製代碼

Book1.rar (12.56 KB)

收藏 分享
Tony

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
2#
發表於 2012-3-22 12:14 | 只看該作者
回復 1# tonycho33


     依照樓主的表示方式
     aa3是原始資料區
     aa1是結果區
     若是這個情況的話~
     建議原始資料區~ 不要進行刪除的條件~
     你要的只是依你條件將aa3的資料放在aa1
     我將結果放在aa1 B欄位中
     依條件~
      aa3 Y欄位中有資料的儲存格放在aa1 B欄位 ,並將[已排]的資料排除,共得到124筆數據
      又
       在aa1 A欄位的表示方式~ 是三個合併儲存格放一筆aa3 Y的資料
  1. Sub ex()

  3. Dim A As Range
  4. For Each A In Sheet3.Range("Y:Y")
  5.     If A <> "" And A.Offset(0, 2) <> "已排" Then
  6.        Sheet1.Range("B" & 3 + N) = A
  7.        Sheet1.Range("B" & 3 + N & ":B" & 3 + N + 2).Merge
  8.        N = N + 3
  9.     End If
  10. Next

  12. End Sub
複製代碼
學習才能提升自己

TOP

        靜思自在 : 盡多少本份，就得多少本事。
返回列表 上一主題