Re: [問題] VBA_轉檔csv,多一列空白

看板Office作者windknife18 (windknife18)時間1年前 (2023/04/22 21:54)推噓1(1推 0噓 0→)

留言1則, 1人參與討論串2/2 (看更多)

1.工具中設定引用項目加入 a. Microsoft Script Control 1.0 b. Microsoft Scripting Runtime 2.新增函數 Function eliminateEmptyRow(fullName As String) As Boolean Dim fso As New FileSystemObject, txtStr As TextStream, objOutputFile As _ TextStream, strText As String If Dir(fullName) <> "" Then Set txtStr = fso.OpenTextFile(fullName) strText = txtStr.ReadAll txtStr.Close Else eliminateEmptyRow = False: Exit Function End If strText = Left(strText, Len(strText) - 2) Set objOutputFile = fso.CreateTextFile(fullName) objOutputFile.Write strText objOutputFile.Close eliminateEmptyRow = True End Function 3. 在你原始的副程式 .Close 下面加入下面呼叫 If Not eliminateEmptyRow(ThisWorkbook.Path & "\" & k(i) & ".csv") Then Stop ※ 引述《gone19 (gone19)》之銘言： : *[1;33m(若是和其他不同軟體互動之問題請記得一併填寫)*[m : 軟體:Office Excel : 版本:2021 : 我從網路上找到VBA CODE並更改一下 : 以某一行當基準分割為多個檔案 : 把AH欄位刪除，轉換成CSV檔 : 但轉出來的CSV檔都會多一列空白列 : 可否用VBA把這列去除?或在這個CODE裡多寫什麼? : 謝謝! : ---------------------------------------- : Sub 保留表頭拆分資料為若干新工作簿() : Dim arr, d As Object, k, t, i&, lc%, rng As Range, c% : c = Application.InputBox("請輸入拆分列號", , 4, , , , , 1) : If c = 0 Then Exit Sub : Application.ScreenUpdating = False : Application.DisplayAlerts = False : arr = [a1].CurrentRegion : lc = UBound(arr, 2) : Set rng = [a1].Resize(, lc) : Set d = CreateObject("scripting.dictionary") : For i = 2 To UBound(arr) : If Not d.Exists(arr(i, c)) Then : Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc) : Else : Set d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc)) : End If : Next : k = d.Keys : t = d.Items : For i = 0 To d.Count - 1 : Range("AH:AH").Delete : With Workbooks.Add(xlWBATWorksheet) : rng.Copy .Sheets(1).[a1] : t(i).Copy .Sheets(1).[a2] : .SaveAs Filename:=ThisWorkbook.Path & "\" & k(i), FileFormat:=xlCSV, CreateBackup:=Fales : .Saved = True : .Close : End With : Next : Application.DisplayAlerts = True : Application.ScreenUpdating = True : MsgBox "完畢" : End Sub -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 1.34.58.193 (臺灣) ※ 文章網址: https://www.ptt.cc/bbs/Office/M.1682171649.A.37F.html