如何导入一个CSV文件到表格？

小女孩

测试.rar (231.12 KB, 下载次数: 4)

2024-7-21 18:25 上传

点击文件名下载附件

我原来的出现问题了，导入内容缺失，哪位老师帮我再写一下，谢谢！原来的文件有错位这个不用处理，就是帮我原样导入就可以，谢谢！

ykcbf1100

代码没有问题，但CSV文件本身有个别数据有错位，造成导入数据也错位了。这个问题还得到CSV文件中修改才行。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.7.21　　CSV文件导入
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("原始数据")
   
5.     sh.UsedRange.Clear
   
6.     p = ThisWorkbook.Path & ""
   
7.     For Each f In fso.GetFolder(p).Files
   
8.         If UCase$(f.Name) Like "*.CSV" Then
   
9.             m = m + 1
   
10.             Set wb = Workbooks.Open(f, 0)
    
11.             With wb.Sheets(1)
    
12.                 If m = 1 Then
    
13.                     .UsedRange.Copy sh.[a1]
    
14.                 Else
    
15.                     r = sh.Cells(Rows.Count, 1).End(3).Row
    
16.                     .UsedRange.Offset(1).Copy sh.Cells(r + 1, 1)
    
17.                 End If
    
18.             End With
    
19.             wb.Close False
    
20.         End If
    
21.     Next f
    
22.     With sh
    
23.         r = .Cells(Rows.Count, 1).End(3).Row
    
24.         For i = 2 To r
    
25.             .Cells(i, 1) = i - 1
    
26.         Next
    
27.     End With
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "OK！"
    
30. End Sub
    

复制代码

小女孩

ykcbf1100 发表于 2024-7-21 18:50
代码没有问题，但CSV文件本身有个别数据有错位，造成导入数据也错位了。这个问题还得到CSV文件中修改才行。 ...

谢谢老师，我的原来代码有问题！

小女孩

源文件有错位，这个没问题，帮我原样导入就可以，哪位帮我一下，谢谢！

小女孩

测试.rar (241.6 KB, 下载次数: 3)

2024-7-21 19:09 上传

点击文件名下载附件

这是我原来的代码，C17单元格没导入进来，肯定有问题，那位老师帮我重写一个，这个很乱套

ykcbf1100

小女孩 发表于 2024-7-21 19:10
这是我原来的代码，C17单元格没导入进来，肯定有问题，那位老师帮我重写一个，这个很乱套

我不是写了代码上传了吗？

小女孩

ykcbf1100 发表于 2024-7-21 19:23
我不是写了代码上传了吗？

您好，谢谢老师的帮助，我发现您一次全部导入了，我要选择文件导入，有的不需要导入，能帮我改一下么

ykcbf1100

小女孩 发表于 2024-7-21 19:29
您好，谢谢老师的帮助，我发现您一次全部导入了，我要选择文件导入，有的不需要导入，能帮我改一下么

选择导入。。。

ykcbf1100

选择导入。。。

1. Sub ykcbf()   '//2024.7.21  选择导入CSV文件
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("原始数据")
   
5.     sh.UsedRange.Clear
   
6.     With Application.FileDialog(msoFileDialogFilePicker)
   
7.         .InitialFileName = ThisWorkbook.Path & ""
   
8.         .Title = "请选择对应Excel文件"
   
9.         .AllowMultiSelect = False
   
10.         .Filters.Clear
    
11.         .Filters.Add "CSV文件", "*.csv"
    
12.         If .Show Then f = .SelectedItems(1) Else Exit Sub
    
13.     End With
    
14.     Set wb = Workbooks.Open(f, 0)
    
15.     With wb.Sheets(1)
    
16.         .UsedRange.Copy sh.[a1]
    
17.     End With
    
18.     wb.Close False
    
19.     Application.ScreenUpdating = True
    
20.     MsgBox "OK！"
    
21. End Sub
    

复制代码