[發問] VBA複製儲存格顏色

各位好，有個問題麻煩各位幫忙解答
目前兩個EXCEL檔，一個用來作出勤登記，一個出勤統計用
統計的部分是依照所需要的日期區間做抓取資料，但因為登記的部分多增加了儲存格顏色來備註，
希望抓到統計那邊時儲存格顏色也能一併過去

Sub Main()
Call 日期區間(S, E)
Call 加補休(S, E)
Call 加班費(S, E)
End Sub
Sub 日期區間(S, E)
S = CDate(Sheets("設定頁").Range("b8"))
E = CDate(Sheets("設定頁").Range("c8"))
End Sub
Sub 加補休(S, E)
'Call 建立新工作表(S, E)
i = 3
x = 2
If Sheets(1).Cells(2, 1) = "" Then
x = 2
Else
x = ActiveSheet.UsedRange.Rows.Count + 1
' MsgBox x
End If
SNAME = Sheets("設定頁").Range("B2") '活頁簿名稱
Do While Workbooks(SNAME).Sheets("補休").Cells(i, 1) <> ""
'MsgBox S
If (Workbooks(SNAME).Sheets("補休").Cells(i, 4) >= CDate(S) And Workbooks(SNAME).Sheets("補休").Cells(i, 4) <= CDate(E)) = True Then
'建立新工作表
Sheets(1).Cells(x, 1) = Workbooks(SNAME).Sheets("補休").Cells(i, 1)
Sheets(1).Cells(x, 2) = Workbooks(SNAME).Sheets("補休").Cells(i, 2)
Sheets(1).Cells(x, 3) = Workbooks(SNAME).Sheets("補休").Cells(i, 12)
Sheets(1).Cells(x, 4) = CDate(Workbooks(SNAME).Sheets("補休").Cells(i, 4))
Sheets(1).Cells(x, 8) = Workbooks(SNAME).Sheets("補休").Cells(i, 5)
x = x + 1
End If
i = i + 1
Loop
End Sub
Sub 加班費(S, E)
'Call 建立新工作表(S, E)
i = 3
x = 2
If Sheets(1).Cells(2, 1) = "" Then
x = 2
Else
x = ActiveSheet.UsedRange.Rows.Count + 1
'MsgBox x
End If
SNAME = Sheets("設定頁").Range("B2") '活頁簿名稱
Do While Workbooks(SNAME).Sheets("加班及請假").Cells(i, 1) <> ""
If Workbooks(SNAME).Sheets("加班及請假").Cells(i, 3) <> "" And Workbooks(SNAME).Sheets("加班及請假").Cells(i, 4) <> "" = True Then
Sheets(1).Cells(x, 1) = Workbooks(SNAME).Sheets("加班及請假").Cells(i, 2)
Sheets(1).Cells(x, 2) = Workbooks(SNAME).Sheets("加班及請假").Cells(i, 3)
Sheets(1).Cells(x, 3) = Workbooks(SNAME).Sheets("加班及請假").Cells(i, 1)
Sheets(1).Cells(x, 4) = CDate(Workbooks(SNAME).Sheets("加班及請假").Cells(i, 4))
Sheets(1).Cells(x, 5) = Workbooks(SNAME).Sheets("加班及請假").Cells(i, 5)
Sheets(1).Cells(x, 6) = Workbooks(SNAME).Sheets("加班及請假").Cells(i, 6)
Sheets(1).Cells(x, 7) = Workbooks(SNAME).Sheets("加班及請假").Cells(i, 7)
x = x + 1
End If
i = i + 1
Loop
End Sub

複製代碼

樓主熱帖

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

2^#

發表於 2020-5-20 00:44 | 只看該作者

本帖最後由 n7822123 於 2020-5-20 00:46 編輯

回復 1# 蘿蔔泥

沒檔案測試，我講方法，請自己改

用"Copy" 取代 "=" 的方式，可以把儲存格格式一併Copy過去

Sheets(1).Cells(x, 1) = Workbooks(SNAME).Sheets("補休").Cells(i, 1)

改成

Workbooks(SNAME).Sheets("補休").Cells(i, 1).Copy Sheets(1).Cells(x, 1)

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

蘿蔔泥

中學生 Rank: 2

帖子: 36
主題: 10
精華: 0
積分: 93
點名: 0
作業系統: win10
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2018-2-27
最後登錄: 2022-2-25

3^#

發表於 2020-5-25 10:18 | 只看該作者

回復 2# n7822123

好，謝謝

TOP

蘿蔔泥

中學生 Rank: 2

帖子: 36
主題: 10
精華: 0
積分: 93
點名: 0
作業系統: win10
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2018-2-27
最後登錄: 2022-2-25

4^#

發表於 2020-5-26 11:02 | 只看該作者

回復 2# n7822123

  你好，請問我做更改會在日期那行會出現錯誤，該怎更改呢？
      Workbooks(SNAME).Sheets("加班及請假").Cells(i, 2).Copy Sheets(1).Cells(x, 1)
      Workbooks(SNAME).Sheets("加班及請假").Cells(i, 3).Copy Sheets(1).Cells(x, 2)
      Workbooks(SNAME).Sheets("加班及請假").Cells(i, 1).Copy Sheets(1).Cells(x, 3)
      CDate(Workbooks(SNAME).Sheets("加班及請假").Cells(i, 4)).copy Sheets(1).Cells(x, 4)
      Workbooks(SNAME).Sheets("加班及請假").Cells(i, 5).Copy Sheets(1).Cells(x, 5)
      Workbooks(SNAME).Sheets("加班及請假").Cells(i, 6).Copy Sheets(1).Cells(x, 6)
      Workbooks(SNAME).Sheets("加班及請假").Cells(i, 7).Copy Sheets(1).Cells(x, 7)

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

5^#

發表於 2020-5-28 02:03 | 只看該作者

本帖最後由 n7822123 於 2020-5-28 02:17 編輯

回復 4# 蘿蔔泥

看看是不是你要的

Workbooks(SNAME).Sheets("加班及請假").Cells(i, 4).copy Sheets(1).Cells(x, 4)
Sheets(1).Cells(x, 4).NumberFormatLocal = "hh:mm:ss AM/PM"

CDate(數值) ---------  O
CDate(物件) ---------  X

儲存格物件.Copy ------- O
值.Copy ----------------X

儲存格是個物件
Copy 是儲存格物件的方法

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP