返回列表 上一主題 發帖

[發問] 如何利用Sheet1的Q欄顏色當標準，複製當列之C:E的值至Sheet2

mark15jill
　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生Rank: 3Rank: 3

帖子
852 
主題
79 
精華
0 
積分
918 
點名
0  
作業系統
Windows 7 , XP 
軟體版本
Office 2007, Office 2003,Office 2010,YoZo Office 
閱讀權限
50 
性別
男 
來自
宇宙 
註冊時間
2011-4-8 
最後登錄
2024-2-21 
1# 跳轉到 »
發表於 2011-6-2 11:12 | 顯示全部帖子
本帖最後由 mark15jill 於 2011-6-2 11:14 編輯

回復 1# 棋語鳥鳴
若是要以 有紫色 儲存格的列下去做複製的話
    可以用篩選 先將紫色部分區別開來
    作法
     1.紫色那欄位弄個標題 再從 B欄位 到Q欄位 反白後 按篩選
     2.在有紫色的那欄位 選擇 依色彩篩選 然後選紫色
     3.等到全部篩選出來 在複製 選擇要貼上的活頁簿 貼上即可

附檔的代碼
  1.     Sheets("sheet1").Select   '---- 一開始要複製的活頁簿名稱  此行不加的話  有可能錯亂
  2.     Columns("B:Q").Select   '--------   資料範圍 (包含 顏色的Q欄位)
  3.     Selection.AutoFilter
  4.     ActiveSheet.Range("$B$2:$Q$50").AutoFilter Field:=16, Criteria1:=RGB(112, _
  5.         48, 160), Operator:=xlFilterCellColor
  6.     Range("B3:G32").Select
  7.     Selection.Copy
  8.     Sheets("Sheet4").Select  '-----  要貼上的活頁簿名稱
  9.     Range("G13").Select    '---- 要貼上的最左上角儲存格位置
  10.     ActiveSheet.Paste
  11.     ActiveWindow.SmallScroll Down:=6
  12.     Sheets("Sheet1").Select
  13.     Range("F4").Select
  14.     Application.CutCopyMode = False
  15.     Selection.AutoFilter
複製代碼
附檔內 已經有將其弄成巨集 請試驗看看吧..

TEST-檔案.rar (14.17 KB)

TOP

mark15jill
　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生Rank: 3Rank: 3

帖子
852 
主題
79 
精華
0 
積分
918 
點名
0  
作業系統
Windows 7 , XP 
軟體版本
Office 2007, Office 2003,Office 2010,YoZo Office 
閱讀權限
50 
性別
男 
來自
宇宙 
註冊時間
2011-4-8 
最後登錄
2024-2-21 
2#
發表於 2011-6-3 08:37 | 顯示全部帖子
本帖最後由 mark15jill 於 2011-6-3 10:36 編輯

回復 3# 棋語鳥鳴

已經弄OK了...
但是強烈建議 不要擅改程式碼...不然  嘿嘿嘿嘿嘿嘿(會當掉喔..
這不是我設下的陷阱 而是 擅改的話 會進入死回圈.. 又+上我是寫成 活頁簿活動的狀態 所以..

PS 這個檔案 是可以直接以欄位 下去做篩選 而沒有指定特定的儲存格...
如果要新增 請將 欄位擴充即可...
如 A:P  ->a欄位到 P欄位


有兩種方法可以試驗
1.按鈕 command
2.核選check

代碼如下
  1. '------在sheet1下
  2. Private Sub CheckBox1_Change()
  3. If CheckBox1.Value = True Then
  4.     Columns("A:P").Select
  5.     Selection.AutoFilter
  6.     Range("Q1").Select
  7.     ActiveSheet.Range("$A$1:$P$49").AutoFilter Field:=16, Criteria1:=RGB(112, _
  8.         48, 160), Operator:=xlFilterCellColor
  9.     Columns("A:P").Select
  10.     Range("P1").Activate
  11.     Selection.Copy
  12.     Sheets("Sheet4").Select
  13.     ActiveSheet.Paste
  14.     Sheets("Sheet1").Select
  15.     Selection.AutoFilter
  16.     Sheets("Sheet1").Select
  17.    
  18. End If
  19.         CheckBox1.Value = False
  20.     Columns("A:P").Select
  21.     Range("P1").Activate
  22.     Selection.AutoFilter

  24. End Sub


  27. Private Sub CommandButton1_Click()
  28.     Columns("a:p").Select
  29.     Range("p1").Activate
  30.     Selection.AutoFilter
  31.     Range("q1").Select
  32.     ActiveSheet.Range("$B$1:$Q$50").AutoFilter Field:=16, Criteria1:=RGB(112, _
  33.         48, 160), Operator:=xlFilterCellColor
  34.     Columns("a:d").Select
  35.     Selection.Copy
  36.     Sheets("Sheet4").Select
  37.    
  38.     ActiveSheet.Paste
  39.     Sheets("Sheet1").Select
  40.     Columns("p:p").Select
  41.     Application.CutCopyMode = False
  42.     Selection.Copy
  43.     Sheets("Sheet4").Select

  45.     Application.CutCopyMode = False
  46. Sheets("sheet1").Select
  47.     Columns("a:p").Select
  48.     Range("p1").Activate
  49.     Selection.AutoFilter
  50. End Sub
複製代碼
  1. '-sheet4下

  3. Private Sub Worksheet_Activate()
  4. If Range("a1").Value = "編號" Then
  5.         Columns("F:O").Select
  6.     Selection.ClearContents
  7.     Selection.Delete Shift:=xlToLeft
  8.     Range("A1").Select
  9.     End
  10. End If

  12. End Sub
複製代碼
TEST-檔案01.rar (210.62 KB)

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
返回列表 上一主題