返回列表 上一主題 發帖

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

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

請問如何複製當Sheet1中的Q欄為紫色時,將其當列ㄉc欄到E欄的值複製至Sheet2的A13:C13,第二個的值貼至A14:C14以此類推,將當列Q欄有紫色部分ㄉC:E貼完,參考檔案在附件,請問此類的巨集該如何寫?? TEST.rar (12.06 KB)

本帖最後由 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

回復 2# mark15jill


    試驗結果可以!請問我要如何將此巨集改為!一開啟Sheet2就自動執行!
印象中好像是把開頭改成這個即可==>Private Sub Worksheet_Activate()
但是不知道為什麼會出現錯誤??
還是我打錯了??

TOP

本帖最後由 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

  23. End Sub


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

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

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

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

TOP

回復 3# 棋語鳥鳴
  1. Private Sub Worksheet_Activate()
  2. [A:C] = ""
  3.    With Sheets("sheet1")
  4.     .Columns("B:Q").AutoFilter
  5.     .Range("$B$2").CurrentRegion.AutoFilter Field:=16, Criteria1:=RGB(112, _
  6.         48, 160), Operator:=xlFilterCellColor
  7.    .[C:E].SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeVisible).Copy [A12]
  8.    .Columns("B:Q").AutoFilter
  9.    End With
  10. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 5# Hsieh
請問第二行A:C是什麼意思??
如果我不要複製到第二列的A   B  C
想直接從C3開始複製,要如何修改(意思就是不要複製C2:E2)???

TOP

  1. Private Sub Worksheet_Activate()
  2. [A12:C1048576] = "" '清空先前資料
  3.    With Sheets("sheet1")
  4.     .Columns("B:Q").AutoFilter '自動篩選
  5.     .Range("$B$2").CurrentRegion.AutoFilter Field:=16, Criteria1:=RGB(112, _
  6.         48, 160), Operator:=xlFilterCellColor '篩選顏色
  7.    .Range(.[C3], .[C1048576].End(xlUp).Offset(, 2)).SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeVisible).Copy [A13] '複製可見儲存格到A13
  8.    .Columns("B:Q").AutoFilter '取消自動篩選
  9.    End With
  10. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 8# Hsieh
A12:C1048576,1048576不知是不是太多,會出現錯誤!我將它改成C100之後即可用
但是:    .Range("$B$2").CurrentRegion.AutoFilter Field:=16, Criteria1:=RGB(112, _
        48, 160), Operator:=xlFilterCellColor '篩選顏色<==這句不知哪裡出了問題!一直出現偵錯(改不好)??

TOP

回復 9# 棋語鳥鳴
2007版本最大列位是1048576沒錯啊,那改成65536試試
如果不是2007以後版本
接下去篩選就不會成立,因為2003版本無法以顏色篩選
若版本正確請將Q欄加上欄名稱
基本上建議EXCEL不要用顏色來統計數值
你的Q欄顏色是用格式化條件而來
應該用條件式來判斷成立與否
學海無涯_不恥下問

TOP

回復 10# Hsieh


    我是2007版的!不過1048576就是不能??不知是我不是我是用二進位活頁簿的關係!
請問一下為什麼我將這句的.Range(.[C3], .[C1048576].End(xlUp).Offset(, 2)).SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeVisible).Copy [A13]
Range(.[C3], .[C1048576]改成Range(.[C3], .[C47]
為什麼不能到預期的效果,他只複製C2:E2而已,但是將C47改成C100卻能使用??因為在檔案中C48有文字敘述,所以如果用C100會將文字刪掉!,所以能否簡略篩選的範圍??

TOP

        靜思自在 : 君子為目標,小人為目的。
返回列表 上一主題