菜鸟问题 高手帮帮忙 谢谢了

Question

我想读取一个多行多列的文本 分隔为空格 
例如 
11 12 13 14 15 16 
13 14 15 16 17 18 
15 16 17 18 19 30 
这样的文本把他读取进excel 每个数放一个单元格  
怎样做？ 能详细点带点解释吗？分不够我可以加 谢谢大家！

Answer 1

参考下面这段代码：Private Sub cmdRefresh_Click()
    Dim Tmp_Str             As String
    Dim Tmp_Arr()           As String
    Dim Tmp_dDate           As String   '日期
On Error GoTo Err_Proc
    lbliCounts.Caption = "记录数：0"
        lbliCounts.Refresh
    If Trim(txtPath.Text) = "" Then
        MsgBox "请先选择TXT文件!", 48, "提示"
        Exit Sub
    End If
            
    
    Open txtPath.Text For Input As #1       '打开文本文件
    HFlexgrid.FixedRows = 0
    HFlexgrid.rows = 1
    
    Do While Not EOF(1)
        Line Input #1, Tmp_Str              '读取一行的内容
        Tmp_Arr = Split(Tmp_Str, " ")          '将内容按空格拆开
        
        With HFlexgrid
            '没有输入考勤机号
            If Trim(txtcMachineID.Text) = "" Then
                If IsNumeric(Tmp_Arr(6)) Then
                    .rows = .rows + 1
                    .TextMatrix(.rows - 1, 0) = .rows - 1            '序号
                    .TextMatrix(.rows - 1, 1) = Trim(Tmp_Arr(0))    '工号
                    '组合得到日期
                    Tmp_dDate = Trim(Tmp_Arr(1)) & "-" & Trim(Tmp_Arr(2)) & "-" & Trim(Tmp_Arr(3)) & " " _
                              & Trim(Tmp_Arr(4)) & ":" & Trim(Tmp_Arr(5))
                    .TextMatrix(.rows - 1, 2) = Tmp_dDate
                    .TextMatrix(.rows - 1, 3) = Trim(Tmp_Arr(6))    '考勤机号
                    .TextMatrix(.rows - 1, 4) = ""                  '操作结果
                End If
            Else
                If Trim(Tmp_Arr(6)) = Trim(txtcMachineID.Text) Then
                    .rows = .rows + 1
                    .TextMatrix(.rows - 1, 0) = .rows - 1            '序号
                    .TextMatrix(.rows - 1, 1) = Trim(Tmp_Arr(0))    '工号
                    '组合得到日期
                    Tmp_dDate = Trim(Tmp_Arr(1)) & "-" & Trim(Tmp_Arr(2)) & "-" & Trim(Tmp_Arr(3)) & " " _
                              & Trim(Tmp_Arr(4)) & ":" & Trim(Tmp_Arr(5))
                    .TextMatrix(.rows - 1, 2) = Tmp_dDate
                    .TextMatrix(.rows - 1, 3) = Trim(Tmp_Arr(6))    '考勤机号
                    .TextMatrix(.rows - 1, 4) = ""                  '操作结果
                End If
            End If
        End With
    Loop
    Close #1
    If HFlexgrid.rows > 1 Then
        HFlexgrid.FixedRows = 1
        lbliCounts.Caption = "记录数：" & HFlexgrid.rows - 1
        lbliCounts.Refresh
        cmdImport.Enabled = True
    End If
    Exit Sub
'错误处理
Err_Proc:
    Close #1
    MsgBox "操作失败，错误原因为：" & Err.Description, vbExclamation, "提示"
    If ar_Tmp.State = adStateOpen Then ar_Tmp.Close
    Exit Sub
End Sub

Answer 2

很感谢楼上的回答，但是没看明白　输入excel方面的解决在上代码哪体现？

Answer 3

调用下面的过程：Sub LoadTxt(strFile As String)    Dim iLine&, sTxtArr$(), sRead$
    Dim iFileNum&, i&, objRange As Range
    
    iLine = 2   '填数据的第一行
    iFileNum = FreeFile()
    Open strFile For Binary As #iFileNum
    While (Not EOF(iFileNum))
        Line Input #iFileNum, sRead
        sTxtArr = Split(sRead, " ")
        Set objRange = Range("A" & iLine)
        For i = 0 To UBound(sTxtArr)
            objRange.Columns(i).FormulaR1C1 = sTxtArr(i)
        Next
        iLine = iLine + 1
    Wend
    Close iFileNumEnd Sub

Answer 4

Sub Macro1()
'
' Macro1 Macro
' 宏由 Wilson.Zhu 录制，时间: 2008-4-25
''
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;E:\data.txt", Destination:=Range( _
        "A1"))
        .Name = "data"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Answer 5

宏?是直接在excel里运行的?

Answer 6

objRange.Columns(i).FormulaR1C1 = sTxtArr(i)改成：
objRange.Columns(i+1).FormulaR1C1 = sTxtArr(i)

Answer 7

Private Sub Command1_Click()
Dim strFile As StringDim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet'读文件
Open "c:\test1.txt" For Binary As #1
strFile = Space(LOF(1))
Get #1, , strFile
Close #1'转为制表符分隔（相当于分成单元格）
strFile = Replace(strFile, Space(1), vbTab)
'打开 Excel 工作簿
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.ActiveSheetxlApp.Visible = True'粘贴
Clipboard.SetText strFile
xlBook.Worksheets(1).PasteEnd Sub

Answer 8

这个解释够详细了吧：
Sub LoadTxt(strFile As String)
'入口参数： （字符串）要“载入”的文件
'最好是用文件的完整路径，因为VBA中，你很难预料“当前路径”是什么
    Dim iLine&, sTxtArr$(), sRead$
    Dim iFileNum&, i&, objRange As Range
    
    iLine = 2   '填数据的第一行
    '一般表格中都有一行表头，数据常从第二行填起
    iFileNum = FreeFile()       '返回一个可用的‘文件号’
    Open strFile For Binary As #iFileNum    '我最喜欢用的打开模式
    While (Not EOF(iFileNum))   '文件未读完继续
        Line Input #iFileNum, sRead     '读取一行文本，赋值给变量
        sTxtArr = Split(sRead, " ")     '以空格为分隔符，拆分成字符串数组
        Set objRange = Range("A" & iLine)   '下面的循环中，以 Axx 为‘基准’来操作
        For i = 0 To UBound(sTxtArr)
        '从字符串数组的 下界到上界 循环
            '把数组的每一个元素，写入从单元格 Axx 算起的第 i+1 列中
            '比如 iLine=2 时，objRange 就是 A2 这个单元格
            'objRange.Columns(1)是A2，objRange.Columns(2)是B2，objRange.Columns(3)是C2
            objRange.Columns(i+1).FormulaR1C1 = sTxtArr(i)
        Next
        iLine = iLine + 1   '‘移’到下一行
    Wend
    Close iFileNum  '关闭文件End Sub