用VBA实现文本文件批量导入Excel

twtjerdf

Private Sub 导入文本数据_Click()
'If Me.TextBox3 = "" Then MsgBox "请选择保存路径！", 64, "提示": Exit Sub '没有存放路径则提示且退出程序
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim MyRng As Range
Dim i As Integer
    Dim j As Integer
Set aimbook = Workbooks.Add(xlWorksheet)
Dim fd As FileDialog, Item As Integer
      
    '如果选择了文件
If fd.Show = -1 Then
        '遍历所有文件
For Item = 1 To fd.SelectedItems.Count
        '逐个打开文件
         Workbooks.Open (fd.SelectedItems(Item))
              
         ActiveWorkbook.Sheets.Select
           Columns("A:A").Select
            Application.CutCopyMode = False
            
  If (CheckBox6.Value) Then      '忽略连续分隔
            
    If (CheckBox2.Value) Then   '空格分隔
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End If
   
    If (CheckBox1.Value) Then    'TAB 键分隔
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End If
   
    If (CheckBox3.Value) Then      '逗号分隔
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End If
   
     If (CheckBox4.Value) Then      '分号分隔
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
     End If
                    
     If (CheckBox5.Value) Then    '自定义分隔
     
            Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False     '消除所有空格
           
             Selection.Replace What:=Me.TextBox1.Value, Replacement:=" ", LookAt:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False     ' 自定义分隔
           
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End If
   
  Else     '不忽略连续分隔

   If (CheckBox2.Value) Then   '空格分隔
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End If
   
    If (CheckBox1.Value) Then    'TAB 键分隔
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End If
   
    If (CheckBox3.Value) Then      '逗号分隔
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End If
   
     If (CheckBox4.Value) Then      '分号分隔
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
     End If
                    
     If (CheckBox5.Value) Then     '自定义分隔
     
             Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False     '消除所有空格
           
             Selection.Replace What:=Me.TextBox1.Value, Replacement:=" ", LookAt:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False   ' 自定义分隔
           
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End If

  End If
        Sheets.Move Before:=aimbook.Sheets(1)
Next
Else
        MsgBox "未发现文件"
End If
  aimbook.SaveAs "导入数据"
  'Shell "EXPLORER.EXE " & Me.TextBox3, vbNormalFocus    '打开存放新工作簿的文件夹
End Sub

justbetoo

楼主的资料很给力

twtjerdf

亲测在Excel2007中可用！将文本文件批量导入Excel是实现数据批量处理的第一步，为地质数据和测井数据的处理打下基础！

一生的爱

如何使用啊

twtjerdf

一生的爱 发表于 2011-12-24 14:44
如何使用啊

首先，你得须要使用这个技术；
其次，这个程序要设计界面，如图所示；
最后，你可以通过学习源代码，稍微改之就可以为已所用了！
VBA的精华就是批量处理，通过批量导入数据或者导出数据，从而理解批量，快速的数据处理思想！

wangshaoqi

看不懂呀，lz，，，，，，

twtjerdf

wangshaoqi 发表于 2011-12-24 17:51
看不懂呀，lz，，，，，，

呵呵，建议先看看VBA的书！

wangshaoqi

twtjerdf 发表于 2011-12-24 17:55
呵呵，建议先看看VBA的书！

VBA ,指计算机二级VB?没有学过呀

twtjerdf

wangshaoqi 发表于 2011-12-24 18:09
VBA ,指计算机二级VB?没有学过呀

不是的，指的是Excel里面的宏，但和VB比较像，专门用来批量处理数据的！

wangshaoqi

twtjerdf 发表于 2011-12-24 18:12
不是的，指的是Excel里面的宏，但和VB比较像，专门用来批量处理数据的！

没有学过VB,但想学一下，
明年考二级VB,我加你QQ吧