標題: [發問] 如何取出已判斷出文字檔內正確位置的下一列再將資料取出呢？ [打印本頁]

---

作者: dechiuan999    時間: 2010-11-17 06:16     標題: 如何取出已判斷出文字檔內正確位置的下一列再將資料取出呢？

各位大大好：
       
  小弟遇到一難題，不知如何解開。
小弟想由文字檔內取出指定資料，
現問題是小弟利用INSTR可找出指定字串number_special時，
再判斷下一列的字串ct101_No時取出數值為：17，也就是
要取出該字串的下一列的部份資料。語法上為
K>0時可判斷出下一列的位置。
小弟不想將文字檔先全部載列於
工作表內，再利用OFFSET方式可逹成。
而是否有其它方式可直接由文字檔的下一
列取出資料呢？

文字檔內的部份資料如下：
<div align="center" class="number_special">
<span id="Lotto649Control_history1_dlQuery_ctl01_No">17</span>&nbsp;</div>
</td>


Sub TEST()   
   
   
    '設定引用項目Microsoft Scripting Runtime
    Dim myFso As Scripting.FileSystemObject
    Dim myTxt As Scripting.TextStream
    Dim myStr As String
    Dim mStr$, mStr1$, nStr1$, nStr2$, nStr3$, nStr4$, nStr5$, nStr6$
    Dim m%, m1%, m2%, mLen%, n%, n1%, n2%, n3%, n4%, n5%, n6%, s1%, s2%, s3%, s4%, s5%, s6%, s7%, s8%
    Dim mSht As Worksheet
    Dim mRng As Range
    Dim mTmp$, mTmp1$, numSpecial$
    Dim myFs As FileSearch
    Dim mPath As String, mFilename$
    Dim i As Long, k%   
   
    numSpecial = "number_special"
    mStr = "DrawTerm"
    mStr1 = "DDate"
    nStr1 = "_No1"
    nStr2 = "_No2"
    nStr3 = "_No3"
    nStr4 = "_No4"
    nStr5 = "_No5"
    nStr6 = "_No6"
   
    Set mSht = Worksheets("temp")
    With mSht
        .Cells.Clear
        Set mRng = .Range("a1:i2000")
        With mRng
            .NumberFormatLocal = "@"
        End With
   
    Set myFs = Application.FileSearch
    mPath = "D:\TEMP\"
   
    With myFs
        .NewSearch
        .LookIn = mPath
        .FileType = msoFileTypeAllFiles
        .Filename = ".txt"
        .SearchSubFolders = True
        
        If .Execute(SortBy:=msoSortByFileName) > 0 Then
            
            For i = 1 To .FoundFiles.Count
                mFilename = .FoundFiles(i)
               
                Set myFso = CreateObject("Scripting.FileSystemObject")
                Set myTxt = myFso.OpenTextFile(Filename:=mFilename, IOMode:=ForReading)
        
                s1 = mSht.[a65536].End(xlUp).Offset(1).Row
                s2 = mSht.[b65536].End(xlUp).Offset(1).Row
                s3 = mSht.[c65536].End(xlUp).Offset(1).Row
                s4 = mSht.[d65536].End(xlUp).Offset(1).Row
                s5 = mSht.[e65536].End(xlUp).Offset(1).Row
                s6 = mSht.[f65536].End(xlUp).Offset(1).Row
                s7 = mSht.[g65536].End(xlUp).Offset(1).Row
                s8 = mSht.[h65536].End(xlUp).Offset(1).Row
   
   
                With myTxt
                Do Until .AtEndOfStream
                    myStr = Trim(.ReadLine)
                    If myStr <> "" Then
                       
                        m = InStr(1, myStr, mStr, vbTextCompare)
                        m1 = InStr(1, myStr, mStr1, vbTextCompare)
                        n1 = InStr(1, myStr, nStr1, vbTextCompare)
                        n2 = InStr(1, myStr, nStr2, vbTextCompare)
                        n3 = InStr(1, myStr, nStr3, vbTextCompare)
                        n4 = InStr(1, myStr, nStr4, vbTextCompare)
                        n5 = InStr(1, myStr, nStr5, vbTextCompare)
                        n6 = InStr(1, myStr, nStr6, vbTextCompare)
                        k = InStr(1, myStr, numSpecial, vbTextCompare)    '如果k>0時要取出下一列的數值資料
            
            
                        If m > 0 Then
                            mLen = Len(myStr)
                            mTmp = Mid(myStr, m + 10, 9)
                            If IsNumeric(mTmp) Then
                                mSht.Cells(s1, 1).Value = mTmp
                            End If
                            s1 = s1 + 1
                        End If
               
                        If m1 > 0 Then
                            mLen = Len(myStr)
                            mTmp = Mid(myStr, m1 + 7, 8)
                            mTmp1 = Replace(mTmp, "/", "")
                    
                            If IsNumeric(mTmp1) Then
                                mSht.Cells(s2, 2).Value = mTmp
                            End If
                            s2 = s2 + 1
                        End If
               
                        If n1 > 0 Then
                            mLen = Len(myStr)
                            mTmp = Mid(myStr, n1 + 6, 2)
                    
                            If IsNumeric(mTmp) Then
                                mSht.Cells(s3, 3).Value = mTmp
                            End If
                            s3 = s3 + 1
                        End If
               
                        If n2 > 0 Then
                            mLen = Len(myStr)
                            mTmp = Mid(myStr, n2 + 6, 2)
                    
                            If IsNumeric(mTmp) Then
                                mSht.Cells(s4, 4).Value = mTmp
                            End If
                            s4 = s4 + 1
                        End If
               
                        If n3 > 0 Then
                            mLen = Len(myStr)
                            mTmp = Mid(myStr, n3 + 6, 2)
                    
                            If IsNumeric(mTmp) Then
                                mSht.Cells(s5, 5).Value = mTmp
                            End If
                            s5 = s5 + 1
                        End If
               
               
                        If n4 > 0 Then
                            mLen = Len(myStr)
                            mTmp = Mid(myStr, n4 + 6, 2)
                    
                            If IsNumeric(mTmp) Then
                                mSht.Cells(s6, 6).Value = mTmp
                            End If
                            s6 = s6 + 1
                        End If
               
                        If n5 > 0 Then
                            mLen = Len(myStr)
                            mTmp = Mid(myStr, n5 + 6, 2)
                    
                            If IsNumeric(mTmp) Then
                                mSht.Cells(s7, 7).Value = mTmp
                            End If
                            s7 = s7 + 1
                        End If
               
                        If n6 > 0 Then
                            mLen = Len(myStr)
                            mTmp = Mid(myStr, n6 + 6, 2)
                    
                            If IsNumeric(mTmp) Then
                                mSht.Cells(s8, 8).Value = mTmp
                            End If
                            s8 = s8 + 1
                        End If
                        
                        
                        
                    End If
                Loop
                .Close
                End With
               
                Set myTxt = Nothing                                    '物件的釋放
                Set myFso = Nothing
            Next
        End If
    End With
   
    End With
   
    mSht.Range("a1:h1") = Array("期別", "日期", "一", "二", "三", "四", "五", "六")
   
    mSht.Range("a1").Sort key1:=Range("a1"), order1:=xlAscending, header:=xlYes
   
    For i = 2 To mSht.[a65536].End(xlUp).Row
        mSht.Cells(i, 10) = mSht.Cells(i, 3) & mSht.Cells(i, 4) & mSht.Cells(i, 5) & mSht.Cells(i, 6) & mSht.Cells(i, 7) & mSht.Cells(i, 8) & mSht.Cells(i, 9)
    Next
    mSht.Range("j1") = "組合字串"
   
   
    Set myFs = Nothing
    Set mSht = Nothing
    Set mRng = Nothing
  
End Sub

感謝各位大大。

---

作者: dechiuan999    時間: 2010-11-17 19:10

謝謝各位大大。
小弟想到一方法可以逹成了。

感謝各位大大！

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)