返回列表 上一主題 發帖

移動有顏色的列到其他sheet(小問題請教)

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2013-11-1 06:45 | 顯示全部帖子
回復 1# jj369963
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh(1 To 2) As Worksheet, i As Integer, R As Integer
  4.     Set Sh(1) = Sheets("無帳密")
  5.     Set Sh(2) = Sheets("無作答")
  6.      Sh(1).UsedRange.Clear
  7.      Sh(2).UsedRange.Clear
  8.     With Sheets("sheet0")
  9.         Sh(1).Rows(1) = .Rows(1).Value
  10.         Sh(2).Rows(1) = .Rows(1).Value
  11.         .Activate
  12.         i = 2
  13.         Do While .Cells(i, "a").FormatConditions.Count = 2
  14.             '2003版 儲存格設定格式化可有3個條件可設公式
  15.             .Cells(i, "a").Select          '需在設定格式化的儲存,方可計算設定格式化條件公式是否成立
  16.             If Application.Evaluate(.Cells(i, "a").FormatConditions(1).Formula1) Then       '計算設定格式化第1個條件公式是否成立
  17.                 R = Sh(1).UsedRange.Rows.Count + 1                                          '計算 UsedRange.Rows 的總數+1
  18.                 Sh(1).Rows(R) = .Cells(i, "a").EntireRow.Value
  19.             ElseIf Application.Evaluate(.Cells(i, "a").FormatConditions(2).Formula1) Then   '計算設定格式化第2個條件公式是否成立
  20.                 R = Sh(2).UsedRange.Rows.Count + 1
  21.                 Sh(2).Rows(R) = .Cells(i, "a").EntireRow.Value
  22.             End If
  23.             i = i + 1
  24.         Loop
  25.     End With
  26. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-11-2 07:00 | 顯示全部帖子
回復 6# jj369963
附檔有2個檔案(工作表名稱都相同)有同時開啟,執行EX程式嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh(1 To 2) As Worksheet, i As Integer, R As Integer
  4.     Set Sh(1) = ThisWorkbook.Sheets("無帳密")  '程式碼所在活頁簿的工作表
  5.     Set Sh(2) = ThisWorkbook.Sheets("無作答")
  6.     '****************************************************************
  7.     'Set Sh(1) = ActiveWorkbook.Sheets("無帳密")  '作用中活頁簿的工作表
  8.     '********************************************************************   
  9.      Sh(1).UsedRange.Clear
  10.      Sh(2).UsedRange.Clear
  11.     With ThisWorkbook.Sheets("sheet0")            '程式碼所在活頁簿的工作表
  12.     '****************************************************************
  13.     'With ActiveWorkbook.Sheets("sheet0")         '作用中活頁簿的工作表
  14.     '****************************************************************
  15.         Sh(1).Rows(1) = .Rows(1).Value
  16.         Sh(2).Rows(1) = .Rows(1).Value
  17.         .Activate
  18.         i = 2
  19.         Do While .Cells(i, "a").FormatConditions.Count = 2 And .Cells(i, "a") <> ""
  20.             '2003版 儲存格設定格式化可有3個條件可設公式
  21.             .Cells(i, "a").Select          '需在設定格式化的儲存,方可計算設定格式化條件公式是否成立
  22.             If Application.Evaluate(.Cells(i, "a").FormatConditions(1).Formula1) Then       '計算設定格式化第1個條件公式是否成立
  23.                 R = Sh(1).UsedRange.Rows.Count + 1                                          '計算 UsedRange.Rows 的總數+1
  24.                 Sh(1).Rows(R) = .Cells(i, "a").EntireRow.Value
  25.             ElseIf Application.Evaluate(.Cells(i, "a").FormatConditions(2).Formula1) Then   '計算設定格式化第2個條件公式是否成立
  26.                 R = Sh(2).UsedRange.Rows.Count + 1
  27.                 Sh(2).Rows(R) = .Cells(i, "a").EntireRow.Value
  28.             End If
  29.             i = i + 1
  30.         Loop
  31.     End With
  32. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2013-11-3 07:05 | 顯示全部帖子
回復 8# jj369963
再試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh(1 To 2) As Worksheet, R As Integer, E As Range
  4.     Set Sh(1) = Sheets("無帳密")
  5.     Set Sh(2) = Sheets("無作答")
  6.      Sh(1).UsedRange.Clear
  7.      Sh(2).UsedRange.Clear
  8.     With Sheets("sheet0")
  9.         Sh(1).Rows(1) = .Rows(1).Value
  10.         Sh(2).Rows(1) = .Rows(1).Value
  11.         .Activate
  12.         For Each E In .UsedRange.Columns(1).Cells
  13.             '2003版 儲存格設定格式化可有3個條件可設公式
  14.              E.Select          '需在設定格式化的儲存,方可計算設定格式化條件公式是否成立
  15.             If E.FormatConditions.Count = 2 Then
  16.                 If Application.Evaluate(E.FormatConditions(1).Formula1) Then       '計算設定格式化第1個條件公式是否成立
  17.                     R = Sh(1).UsedRange.Rows.Count + 1                                          '計算 UsedRange.Rows 的總數+1
  18.                     Sh(1).Rows(R) = E.EntireRow.Value
  19.                 ElseIf Application.Evaluate(E.FormatConditions(2).Formula1) Then   '計算設定格式化第2個條件公式是否成立
  20.                     R = Sh(2).UsedRange.Rows.Count + 1
  21.                     Sh(2).Rows(R) = E.EntireRow.Value
  22.                 End If
  23.             End If
  24.         Next
  25.     End With
  26. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2013-11-7 15:15 | 顯示全部帖子
本帖最後由 GBKEE 於 2013-11-7 15:23 編輯

回復 10# jj369963
如圖示依你6#的檔案執行7#的程式,
你說的執行語法後只有標題列移過去，格式化的列沒有移到對應的sheet,(百思不解..)
2003版中 RGB(3, 255, 101)  ->  傳回一個數值  Criteria1=RGB(3, 255, 101) -> 這函數傳回的數字
  1. 'xlFilterCellColor這參數為2010版的不適用2003
  2. ActiveSheet.Range("$A$1:$CQ$370").AutoFilter Field:=6, Criteria1:=RGB(3, 255, 101), Operator:=xlFilterCellColor
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。
返回列表 上一主題