返回列表 上一主題 發帖

[發問] 資料轉移

ounmaxz

帖子
19 
主題
4 
精華
0 
積分
35 
點名
0  
作業系統
windows XP sp3 
軟體版本
office 2007 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2010-6-10 
最後登錄
2013-8-6 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2010-6-10 16:09 | 只看該作者

[發問] 資料轉移

本帖最後由 ounmaxz 於 2010-6-10 16:14 編輯

請各位大大幫忙一下將加班統計表內的資料
經輸入日期後將資料轉移到加班統計表內
有填入加班時間及加班事由才移轉
煩請各位大大幫忙   加班.rar (13.53 KB)
收藏 分享

ounmaxz

帖子
19 
主題
4 
精華
0 
積分
35 
點名
0  
作業系統
windows XP sp3 
軟體版本
office 2007 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2010-6-10 
最後登錄
2013-8-6 
2#
發表於 2010-6-11 13:46 | 只看該作者
Sub nn()
Dim Rng As Range, A As Range, Cell As Range
With Sheet2
Set Rng = .Range(.[N5], .[N7].End(xlUp)) '設置比對的標準區域
End With
With Sheet1
For Each A In .Range(.[A1], .[A65536].End(xlUp)) '在sheet1的d欄資料循環
    If Not Rng.Find(A, lookat:=xlWhole) Is Nothing Then '如果標準區找到d欄的值
       If Cell Is Nothing Then Set Cell = A Else Set Cell = Union(Cell, A) '如果變數Cell是不是物件就將d欄設給Cell否則Cell就會將原來範圍增加一儲存格A
    End If
Next
End With
Sheet3.Cells = "" '清空Sheet3內容
Cell.EntireRow.Copy Sheet3.[A2] '把Sheet1符合的列複製到Sheet3的A1
   
End Sub
以上程式碼是小弟從舊論壇翻出來進行小修改後的
小弟希望改幾個小地方但是無奈對VBA不熟悉
無從修改煩請大大協助一下
上面的第一項篩選條件是日期
但是小弟還需要有N欄有加班的才篩選出來
第二是此程式碼會將格是及公式帶過來小弟希望只帶值就好
Sheet3.Cells = "" '清空Sheet3內容是否能改成只清空適當區域
加班申請表內[A5，H20]
煩請各位大大幫幫忙
加班.rar (39.62 KB)

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-28 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2010-6-12 11:16 | 只看該作者
回復 2# ounmaxz


    看不出單位如何對應先以"單位"代表
  1. Sub nn()
  2. Dim Rng As Range, A As Range, Ar(), Ay()
  3. With Sheet2
  4. Set Rng = .Range(.[N5], .[N7].End(xlUp)) '設置比對的標準區域
  5. With Sheet1
  6. ReDim Preserve Ay(0)
  7. Ay(0) = .[A1].Resize(, 14).Value
  8. For Each A In .Range(.[A1], .[A65536].End(xlUp)) '在sheet1的d欄資料循環
  9.     If Not Rng.Find(A, lookat:=xlWhole) Is Nothing And A.Offset(, 13) = "加班" Then '如果標準區找到d欄的值
  10.        ReDim Preserve Ar(s)
  11.        ReDim Preserve Ay(s + 1)
  12.        Ar(s) = Array("單位", A.Value, A.Offset(, 1).Value, "", A.Offset(, 2).Value, Format(A.Offset(, 3).Value, "hh:mm"), Format(A.Offset(, 4).Value, "hh:mm"), A.Offset(, 5).Value)
  13.        Ay(s + 1) = A.Resize(, 14).Value
  14.        s = s + 1
  15.     End If
  16. Next
  17. End With
  18. .[A5:I20] = ""
  19. Sheet3.Cells = "" '清空Sheet3內容
  20. If s > 0 Then .[A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar)): _
  21. Sheet3.[A1].Resize(s + 1, 14) = Application.Transpose(Application.Transpose(Ay)) '把Sheet1符合的列複製到Sheet3的A1
  22. End With
  23. End Sub
複製代碼
學海無涯_不恥下問

TOP

ounmaxz

帖子
19 
主題
4 
精華
0 
積分
35 
點名
0  
作業系統
windows XP sp3 
軟體版本
office 2007 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2010-6-10 
最後登錄
2013-8-6 
4#
發表於 2010-6-13 16:15 | 只看該作者
回復 3# Hsieh


   感謝Hsieh大大的幫忙有兩個問題要在麻煩大大幫忙
1.Ar(s) = Array("單位", A.Value, A.Offset(, 1).Value, "", A.Offset(, 2).Value, Format(A.Offset(, 3).Value, "hh:mm"), Format(A.Offset(, 4).Value, "hh:mm"), A.Offset(, 5).Value)
       Ay(s + 1) = A.Resize(, 14).Value
       s = s + 1
紅色的部分能不能改成由附件Sheet2內的值來取代
第2的部分在附件SHEET1裡有說明比較清楚

再次麻煩大大
加班.rar (42.55 KB)

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-28 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 2010-6-14 14:28 | 只看該作者
回復 4# ounmaxz
  1. Sub nn()
  2. Dim Rng As Range, A As Range, Ar(), Ay()
  3. With Sheet2
  4. Ut = .[P5].Value
  5. Set Rng = .Range(.[N5], .[N65536].End(xlUp)) '設置比對的標準區域
  6. With Sheet1
  7. ReDim Preserve Ay(0)
  8. Ay(0) = .[A1].Resize(, 14).Value
  9. For Each A In .Range(.[A1], .[A65536].End(xlUp)) '在sheet1的d欄資料循環
  10.     If Not Rng.Find(A, lookat:=xlWhole) Is Nothing And A.Offset(, 13) = "加班" Then '如果標準區找到d欄的值
  11.        ReDim Preserve Ar(s)
  12.        ReDim Preserve Ay(s + 1)
  13.        Ar(s) = Array(Ut, A.Value, A.Offset(, 1).Value, "", A.Offset(, 2).Value, Format(A.Offset(, 3).Value, "hh:mm"), Format(A.Offset(, 4).Value, "hh:mm"), A.Offset(, 5).Value)
  14.        Ay(s + 1) = A.Resize(, 14).Value
  15.        s = s + 1
  16.     End If
  17. Next
  18. End With
  19. .[A5:I20] = ""
  20. Sheet3.Cells = "" '清空Sheet3內容
  21. If s > 0 Then .[A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar)): _
  22. Sheet3.[A1].Resize(s + 1, 14) = Application.Transpose(Application.Transpose(Ay)) '把Sheet1符合的列複製到Sheet3的A1
  23. End With
  24. End Sub

  26. Sub yy() '填滿日期
  27. y = InputBox("輸入西元年度", , 2010)
  28. With Sheet1
  29. Ar = .[B2:C17].Value
  30. r = 2
  31. For i = DateValue(y & "/1/1") To DateValue(y & "/12/31")
  32.   .Cells(r, 1).Resize(16, 1) = i
  33.   .Cells(r, 2).Resize(16, 2) = Ar
  34.   r = r + 16
  35. Next
  36. End With
  37. End Sub
複製代碼
學海無涯_不恥下問

TOP

ounmaxz

帖子
19 
主題
4 
精華
0 
積分
35 
點名
0  
作業系統
windows XP sp3 
軟體版本
office 2007 
閱讀權限
10 
性別
男 
來自
台灣 
註冊時間
2010-6-10 
最後登錄
2013-8-6 
6#
發表於 2010-6-14 16:55 | 只看該作者
感謝Hsieh 的熱情幫助讓小弟受益良多

TOP

        靜思自在 : 修行要繫緣修心，藉事練心，隨處養心。
返回列表 上一主題