[求助]TXT轉XLS時的問題(已解決)

MYTAO1976

　　每天需要從系統里導出資料來進行整理。學著自己錄製巨集並根據高手門的指點完成了部分修改，現在仍然有部分問題需要修正，請各位指教！

謝謝了

操作過程說明在3樓,

求助問題在下面代碼,文字說明的部分

Sub 住宿費分析() ' ' 住宿費分析 Macro ' 住宿費分析 Dim SNAME As String Dim ICOUNT As Integer

SNAME = Application.GetOpenFilename("TEXT FILES(*.TXT),*.TXT") Workbooks.OpenText Filename:=(SNAME), Origin:=950, _ StartRow:=1, DataType:=xlFixedWidth, FieldInf=Array(Array(0, 9), Array(17 _ , 9), Array(23, 9), Array(35, 2), Array(44, 2), Array(54, 1), Array(59, 5), Array(70, 5), _ Array(80, 5), Array(90, 2)), TrailingMinusNumbers:=True

ICOUNT = Worksheets(1).[a65536].End(xlUp).Row

Application.Goto Reference:="R1C1:R4853C7" '此處4853需要使用 ICOUNT Selection.AutoFilter Selection.AutoFilter Field:=7, Criteria1:="<>F", Operator:=xlAnd, _ Criteria2:="<>M" Rows("2:4853").Select '此處4853需要使用 ICOUNT Selection.Delete Shift:=xlUp Range("A1:G4853").Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlStroke, DataOption1:=xlSortNormal '此處4853需要使用 ICOUNT Selection.AutoFilter Range("A1") = "工號" Range("B1") = "姓名" Range("C1") = "金額" Range("D1") = "起扣日" Range("E1") = "截止日" Range("F1") = "到職日" Range("G1") = "性別" Columns("A:G").EntireColumn.AutoFit

Range("A1:G4853").Select '此處4853需要使用 ICOUNT Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlStroke, DataOption1:=xlSortNormal

ActiveWorkbook.SaveAs Filename:="D:\2005年\宿舍\新資料夾\20050801.xls", FileFormat _ :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _ False, CreateBackup:=False '文件名如何自動使用原文件名並存成XLS檔呢? End Sub

[此贴子已经被作者于2005-8-3 11:24:02编辑过]

MYTAO1976

老大阿,TXT文件不太方便給阿,

主要是將文字資料剖析分列,然後利用自動篩選刪除多餘的數據.

最後將資料排一下序,保存.

MYTAO1976

HELP!!

kevin15

你就随便把一些数据更改一下，然后作为txt文件上传啊，这样的话有针对性了。

MYTAO1976

修正完成

谢谢各位

Sub FENXI() ' ' 住宿費分析 Macro ' 住宿費分析 Dim SNAME As String Dim ICOUNT As Integer

SNAME = Application.GetOpenFilename("TEXT FILES(*.TXT),*.TXT") '設定文件為TXT檔 Workbooks.OpenText Filename:=(SNAME), Origin:=950, _ StartRow:=1, DataType:=xlFixedWidth, FieldInf=Array(Array(0, 9), Array(17 _ , 9), Array(23, 9), Array(35, 2), Array(44, 2), Array(54, 1), Array(59, 5), Array(70, 5), _ Array(80, 5), Array(90, 2)), TrailingMinusNumbers:=True '打開制定文件 ICOUNT = Worksheets(1).[a65536].End(xlUp).Row 'A列最後數據行數

Application.Goto Reference:="=R1C1:R[" & ICOUNT & "]C7" '注意引用ICOUNT的寫法

Selection.AutoFilter Field:=7, Criteria1:="<>F", Operator:=xlAnd, _ Criteria2:="<>M" '篩選第七列不等於F且不等於M的數據 Rows("2:" & ICOUNT).Select '注意引用ICOUNT的寫法 Selection.Delete Shift:=xlUp Range("A1:G" & ICOUNT).Sort Key1:=Range("G1"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlStroke, DataOption1:=xlSortNormal Selection.AutoFilter '取消自動篩選 Range("A1") = "工號" Range("B1") = "姓名" Range("C1") = "金額" Range("D1") = "起扣日" Range("E1") = "截止日" Range("F1") = "到職日" Range("G1") = "性別" Columns("A:G").EntireColumn.AutoFit '設置A到G列的列寬為自動

Range("A1:G" & ICOUNT).Select Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlStroke, DataOption1:=xlSortNormal '按照第一列降序排序 Dim NIAN, YUE, RI As String NIAN = Format(Year(Date), "000#") YUE = Format(Month(Date), "0#") RI = Format(Day(Date), "0#") ActiveWorkbook.SaveAs "D:\2005年\宿舍\新資料夾\" & NIAN & YUE & RI, FileFormat _ :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _ False, CreateBackup:=False '把文件轉存為制定資料夾下,按照年月日命名. End Sub

Long_III

没有数据、没有txt文件啊

最好说明操作过程

ailisiji

楼主辛苦了，不错的东西