VANESSA

帖子: 100
主題: 37
精華: 0
積分: 139
點名: 0
作業系統: xp
軟體版本: office2007
閱讀權限: 20
性別: 女
來自: 台灣
註冊時間: 2010-8-11
最後登錄: 2024-3-12

論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2020-8-14 12:38 | 只看該作者

EXCEL清單如何轉換成財政部電子發票格式

我有一份EXCEL清單(同一行有發票單頭及發票單身,如果單身有2行,那個單頭就會重覆),請問如何轉換成財政部電子發票CSV的格式(單頭一行,下一行單身,一個品名一行,再換下一個單頭,再換下一筆單身 )
請各位大大幫幫忙,謝謝

活頁簿1.zip (22 Bytes)

樓主熱帖

s3526369

　暱稱: 大榮

中學生 Rank: 2

帖子: 46
主題: 3
精華: 0
積分: 73
點名: 0
作業系統: WIN7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2018-2-12
最後登錄: 2025-9-17

8^#

發表於昨天 09:18 | 只看該作者

回復 6# VANESSA

Sub 載入()
Dim xR As Range, xH As Range, T$
[工作表2!A1:L3000].ClearContents
[工作表1!A1].Resize(1, 5).Copy [工作表2!A1:E1]  ''<---新增這一段
Set xH = [工作表2!A2]
Application.ScreenUpdating = False
For Each xR In Range([工作表1!A1], [工作表1!A65536].End(xlUp))
If xR <> "M" Then GoTo 101
If xR(1, 2) <> T Then
   xR.Resize(1, 12).Copy xH
   Set xH = xH(2):  T = xR(1, 2)
End If
xR(1, 16).Resize(1, 6).Copy xH
Set xH = xH(2)
101: Next
End Sub

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2025-8-22

7^#

發表於 2021-4-14 10:53 | 只看該作者

回復 6# VANESSA

不太能了解您的意思，可以上傳完成後的檔案嗎? 謝謝。

TOP

VANESSA

中學生 Rank: 2

帖子: 100
主題: 37
精華: 0
積分: 139
點名: 0
作業系統: xp
軟體版本: office2007
閱讀權限: 20
性別: 女
來自: 台灣
註冊時間: 2010-8-11
最後登錄: 2024-3-12

論壇贊助勳章

6^#

發表於 2021-4-13 20:37 | 只看該作者

請問如果我想每次執行VBA時,他可以固定先產生下列這行,應該要如何行修改VBA?
H 12345678 測試股份有限公司台北市中正區 02-88888888

TOP

VANESSA

中學生 Rank: 2

帖子: 100
主題: 37
精華: 0
積分: 139
點名: 0
作業系統: xp
軟體版本: office2007
閱讀權限: 20
性別: 女
來自: 台灣
註冊時間: 2010-8-11
最後登錄: 2024-3-12

論壇贊助勳章

5^#

發表於 2020-8-18 16:49 | 只看該作者

回復 4# 准提部林

可以吔,謝謝,

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2843
主題: 10
精華: 0
積分: 2899
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-8-20

4^#

發表於 2020-8-15 10:08 | 只看該作者

表身筆數不定, 用vba吧!
增加一個工作表2:
Sub 載入()
Dim xR As Range, xH As Range, T$
[工作表2!A1:L3000].ClearContents
Set xH = [工作表2!A1]
Application.ScreenUpdating = False
For Each xR In Range([工作表1!A1], [工作表1!A65536].End(xlUp))
If xR <> "M" Then GoTo 101
If xR(1, 2) <> T Then
xR.Resize(1, 12).Copy xH
Set xH = xH(2): T = xR(1, 2)
End If
xR(1, 16).Resize(1, 6).Copy xH
Set xH = xH(2)
101: Next
End Sub