| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 931 人关注过本帖
标题:求教,将CSV文件转换成excel文件的问题。
只看楼主 加入收藏
ictest
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:333
专家分:114
注 册:2010-2-17
结帖率:70%
收藏
已结贴  问题点数:20 回复次数:3 
求教,将CSV文件转换成excel文件的问题。
如题,代码如下:
程序代码:
Sub txttoexcel(txtfile As String, distancechar As String)
    '建立excel对象
    Dim hang As Integer
    Dim XlApp As New Excel.Application
    Dim xlwb As New Excel.Workbook
    Dim xlst As New Excel.Worksheet
    Set XlApp = CreateObject("excel.application")
    Set xlwb = XlApp.Workbooks.Add
    xlwb.SaveAs FileName:=Left(txtfile, Len(txtfile) - 4) & ".xlsx"
    Set xlst = xlwb.Worksheets(1)
    '开始转换
    Dim J As Integer, linenext As String, strb() As String
    J = 1
    hang = 0
    Open txtfile For Input As #1
    Do Until EOF(1)
        Line Input #1, linenext
        hang = hang + 1
        strb = Split(linenext, distancechar)
        For i = 0 To UBound(strb)
            xlst.Cells(J, i + 1) = strb(i)
        Next
        J = J + 1
    Loop
    Close #1    '结束,释放空间
    XlApp.Workbooks(1).Worksheets(1).Cells.HorizontalAlignment = xlCenter
    XlApp.Workbooks(1).Worksheets(1).Cells.VerticalAlignment = xlCenter
    XlApp.Workbooks(1).Worksheets(1).Cells.WrapText = False
    XlApp.Workbooks(1).Worksheets(1).Cells.Orientation = 0
    XlApp.Workbooks(1).Worksheets(1).Cells.AddIndent = False
    XlApp.Workbooks(1).Worksheets(1).Cells.IndentLevel = 0
    XlApp.Workbooks(1).Worksheets(1).Cells.ShrinkToFit = False
    XlApp.Workbooks(1).Worksheets(1).Cells.ReadingOrder = xlContext
    XlApp.Workbooks(1).Worksheets(1).Cells.MergeCells = False
    XlApp.Workbooks(1).Worksheets(1).Cells.EntireColumn.AutoFit
    XlApp.Workbooks(1).Worksheets(1).Range(Cells(1, 1), Cells(hang, 140)).Borders.LineStyle = xlContinuous
    xlwb.Save

    
    Set xlst = Nothing
    xlwb.Close
    Set xlwb = Nothing
    XlApp.Quit
    Set XlApp = Nothing
    
End Sub


现在问题是

如果执行语句如下,可以正常运行:
程序代码:
Private Sub Command1_Click()
txttoexcel App.Path & "\SUMMARY_Week.csv", ","
End Sub


但如果执行语句如下,运行到这一条语句就会报错:

XlApp.Workbooks(1).Worksheets(1).Range(Cells(1, 1), Cells(hang, 140)).Borders.LineStyle = xlContinuous

程序代码:
Private Sub Command1_Click()
txttoexcel App.Path & "\SUMMARY_Week.csv", ","
txttoexcel Dir1.Path & "\SUMMARY.csv", ","
End Sub

图片附件: 游客没有浏览图片的权限,请 登录注册



请教各位路过的大大们怎么会出错?如何修改?


[此贴子已经被作者于2022-12-16 16:24编辑过]

搜索更多相关主题的帖子: CSV 文件 excel Set Sub 
2022-12-16 16:22
ictest
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:333
专家分:114
注 册:2010-2-17
收藏
得分:0 
也就是说,上面的txttoexcel只能运行一次,连着运行第二次就出错。
是什么问题呢?是第一次运行的excel没有退干净吗?
麻烦路过的大大帮着检查一下,给个解决方案吧?谢谢啦!
2022-12-17 11:15
醉里流年
Rank: 2
等 级:论坛游民
帖 子:7
专家分:20
注 册:2021-9-13
收藏
得分:20 
cells没有父级对象所以识别错误吧?
XlApp.Workbooks(1).Worksheets(1).Cells.HorizontalAlignment = xlCenter
    XlApp.Workbooks(1).Worksheets(1).Cells.VerticalAlignment = xlCenter
    XlApp.Workbooks(1).Worksheets(1).Cells.WrapText = False
    XlApp.Workbooks(1).Worksheets(1).Cells.Orientation = 0
    XlApp.Workbooks(1).Worksheets(1).Cells.AddIndent = False
    XlApp.Workbooks(1).Worksheets(1).Cells.IndentLevel = 0
    XlApp.Workbooks(1).Worksheets(1).Cells.ShrinkToFit = False
    XlApp.Workbooks(1).Worksheets(1).Cells.ReadingOrder = xlContext
    XlApp.Workbooks(1).Worksheets(1).Cells.MergeCells = False
    XlApp.Workbooks(1).Worksheets(1).Cells.EntireColumn.AutoFit
    XlApp.Workbooks(1).Worksheets(1).Range(Cells(1, 1), Cells(hang, 140)).Borders.LineStyle = xlContinuous

上面这段话,改成with语句呗
with XlApp.Workbooks(1).Worksheets(1)
    .Cells.VerticalAlignment = xlCenter
    ……(省略中间一堆)
    .Range(.Cells(1, 1), .Cells(hang, 140)).Borders.LineStyle = xlContinuous
end with
或者不修改,把出错的那句改成XlApp.Workbooks(1).Worksheets(1).Range("A1:EJ" & hang).Borders.LineStyle = xlContinuous试试
2022-12-22 14:44
yuma
Rank: 12Rank: 12Rank: 12
来 自:银河系
等 级:贵宾
威 望:37
帖 子:1934
专家分:3012
注 册:2009-12-22
收藏
得分:0 
程序代码:
Sub TxtToExcel(TxtFile As String, DisTancechar As String)
    '建立excel对象
    Dim hang As Integer
    Set XlApp = CreateObject("excel.application")
    Set xlwb = XlApp.Workbooks.Add
    xlwb.SaveAs FileName:=Left(TxtFile, Len(TxtFile) - 4) & ".xlsx"
    Set xlst = xlwb.Worksheets(1)
    '开始转换
    Dim J As Integer, linenext As String, strb() As String
    J = 1
    hang = 0
    Open TxtFile For Input As #1
    Do Until EOF(1)
        Line Input #1, linenext
        hang = hang + 1
        strb = Split(linenext, DisTancechar)
        For i = 0 To UBound(strb)
            xlst.Cells(J, i + 1) = strb(i)
        Next
        J = J + 1
    Loop
    Close #1    '结束,释放空间
    XlApp.Workbooks(1).Worksheets(1).Cells.WrapText = False
    XlApp.Workbooks(1).Worksheets(1).Cells.Orientation = 0
    XlApp.Workbooks(1).Worksheets(1).Cells.AddIndent = False
    XlApp.Workbooks(1).Worksheets(1).Cells.IndentLevel = 0
    XlApp.Workbooks(1).Worksheets(1).Cells.ShrinkToFit = False
    XlApp.Workbooks(1).Worksheets(1).Cells.MergeCells = False
    XlApp.Workbooks(1).Worksheets(1).Cells.EntireColumn.AutoFit
    XlApp.Workbooks(1).Worksheets(1).Range("A1:EJ" & hang).Borders.LineStyle = xlContinuous
    xlwb.Save

    
    Set xlst = Nothing
    xlwb.Close
    Set xlwb = Nothing
    XlApp.Quit
    Set XlApp = Nothing
    
End Sub

Private Sub Form_Load()
TxtToExcel "C:\Users\Admin\Desktop\1.csv", ","
End Sub

心生万象,万象皆程序!
本人计算机知识网:http://bbs.为防伸手党,本站已停止会员注册。
2023-01-10 10:39
快速回复:求教,将CSV文件转换成excel文件的问题。
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.020251 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved