麻辣家族討論版版 » Excel程式區 » 如何拆解個人薪資

返回列表下一主題上一主題發帖

如何拆解個人薪資

高中生 Rank: 3 Rank: 3

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

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.

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2017-6-16 14:53 | 只看該作者

Sub save_out()
Dim a As Range
With 工作表1
Set Rng = .Range("A3").Resize(2, 35)
For Each a In .Columns("A:A").SpecialCells(xlCellTypeConstants, 1)
f = a.Offset(, 1)
If f = "" Then GoTo 10
With Sheets.Add
Rng.Copy .[A3]
a.Resize(4, 35).Copy .[A5]
.Move
With ActiveWorkbook
.SaveAs "D:\" & f & ".xlsx"
.Close
End With
End With
10
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

高中生 Rank: 3 Rank: 3

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

3^#

發表於 2017-6-17 10:34 | 只看該作者

回復 2# Hsieh
Hi Hsieh
感謝您的回覆，在執行VBA過程中有出現錯誤訊息，是否可以教島一下該如何處理呢?
謝謝您!

Just do it.

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 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 三鍵輸入公式

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 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

Sub 每人資料另存新檔()
Dim x表頭區 As Range, x資料區 As Range
Dim xWB As Workbook, xWS As Worksheet
Set xWS = ThisWorkbook.Sheets("Sheet1")
Set x表頭區 = xWS.Range("A3:AI4")
Set x資料區 = xWS.Range("A5:AI8")
Application.DisplayAlerts = False '停止系統的警示 - 是否覆蓋舊檔
Do While x資料區(1, 1) <> ""
With Workbooks.Add
x表頭區.Copy .Sheets(1).Range("A3")
x資料區.Copy .Sheets(1).Range("A5")
.SaveAs "D:\" & x資料區(1, 2) & ".xlsx"
.Close
End With
Set x資料區 = x資料區.Offset(4)
Loop
Application.DisplayAlerts = True '恢復系統的警示
End Sub

複製代碼

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

高中生 Rank: 3 Rank: 3

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

6^#

發表於 2017-6-19 18:28 | 只看該作者

回復 5# ML089

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

Just do it.

靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。

返回列表下一主題上一主題