返回列表 上一主題 發帖

如何拆解個人薪資

jsc0518

帖子
455 
主題
111 
精華
0 
積分
563 
點名
199  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2013-11-7 
最後登錄
2025-10-26 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2017-6-15 12:47 | 只看該作者

如何拆解個人薪資

各位先進大家好，
1.原本薪資都在同一個EXCEL工作表中，我想要依個人名字拆分成個別的檔案
   ex : 張三.xlsx    李日.xlsx   王五.xlsx ......

2.但是我碰到的是一個人員就有4列的資訊


3.想請教VBA該如何撰寫(之前有找過網路，他是個人資訊僅一列，所以可以拆。但我的現況是個人資訊有4列)
薪資表-01.rar (12.13 KB)

再請大家幫幫忙。
收藏 分享
Just do it.

jsc0518

帖子
455 
主題
111 
精華
0 
積分
563 
點名
199  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2013-11-7 
最後登錄
2025-10-26 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章論壇贊助勳章
6#
發表於 2017-6-19 18:28 | 只看該作者
回復 5# ML089

真的很感謝你的幫忙，謝謝你的回覆。讓我解決了一大困擾
Just do it.

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
5#
發表於 2017-6-18 18:35 | 只看該作者
回復 1# jsc0518
  1. Sub 每人資料另存新檔()
  2.     Dim x表頭區 As Range, x資料區 As Range
  3.     Dim xWB As Workbook, xWS As Worksheet

  5.     Set xWS = ThisWorkbook.Sheets("Sheet1")
  6.     Set x表頭區 = xWS.Range("A3:AI4")
  7.     Set x資料區 = xWS.Range("A5:AI8")

  9.     Application.DisplayAlerts = False '停止系統的警示 - 是否覆蓋舊檔
  10.     Do While x資料區(1, 1) <> ""
  11.         With Workbooks.Add
  12.             x表頭區.Copy .Sheets(1).Range("A3")
  13.             x資料區.Copy .Sheets(1).Range("A5")
  14.             .SaveAs "D:\" & x資料區(1, 2) & ".xlsx"
  15.             .Close
  16.         End With
  17.         Set x資料區 = x資料區.Offset(4)
  18.     Loop
  19.     Application.DisplayAlerts = True '恢復系統的警示

  21. End Sub
複製代碼
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
4#
發表於 2017-6-18 18:09 | 只看該作者
回復 3# jsc0518

我是WIN7-64 及 OFFICE2007-32，原來執行也是有問題，後來更新電腦系統後就可以正常執行了。

更新檔案為 Microsoft .NET Framework 4.7
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

jsc0518

帖子
455 
主題
111 
精華
0 
積分
563 
點名
199  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2013-11-7 
最後登錄
2025-10-26 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章論壇贊助勳章
3#
發表於 2017-6-17 10:34 | 只看該作者
回復 2# Hsieh
Hi Hsieh
感謝您的回覆，在執行VBA過程中有出現錯誤訊息，是否可以教島一下該如何處理呢?
謝謝您!
Just do it.

TOP

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2017-6-16 14:53 | 只看該作者
  1. Sub save_out()
  2. Dim a As Range
  3. With 工作表1
  4.    Set Rng = .Range("A3").Resize(2, 35)
  5.    For Each a In .Columns("A:A").SpecialCells(xlCellTypeConstants, 1)
  6.    f = a.Offset(, 1)
  7.    If f = "" Then GoTo 10
  8.    With Sheets.Add
  9.       Rng.Copy .[A3]
  10.       a.Resize(4, 35).Copy .[A5]
  11.       .Move
  12.      With ActiveWorkbook
  13.         .SaveAs "D:\" & f & ".xlsx"
  14.         .Close
  15.      End With
  16.     End With
  17. 10
  18.    Next
  19. End With
  20.      
  21. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 原諒別人就是善待自己。
返回列表 上一主題