Excel VBA：通過選定列範圍從txt文件讀取特定行

Question

我是新的excel vba腳本。我需要的是獲得LZFmax數據。
測量結果

Band [Hz] 6.3   8.0   10.0  12.5  16.0  20.0  25.0  31.5  40.0  50.0  63.0  80.0  100.0  125.0  160.0  200.0  250.0  315.0  400.0  500.0  630.0  800.0  1000.0  1250.0  1600.0  2000.0  2500.0  3150.0  4000.0  5000.0  6300.0  8000.0  10000.0  12500.0  16000.0  20000.0 

      [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  [dB]  

LZFmax  88.5  81.9  72.8  71.5  70.3  71.0  75.0  69.9  76.5  86.9  93.4  97.9  93.4  86.7  88.8  99.4  98.0  100.8  103.4  97.6  101.4  96.5  93.3  90.2  88.5  91.2  85.2  86.7  80.9  78.4  79.8  80.3  75.8  68.9  66.9  63.9  

LZFmin  20.0  21.4  22.8  20.1  24.6  24.6  28.7  30.5  32.8  35.0  29.0  35.6  34.5  38.0  39.4  39.0  42.5  40.1  41.9  41.7  43.0  39.2  38.5  37.5  36.7  35.4  34.7  34.8  34.6  34.2  34.7  35.7  36.6  37.5  38.9  40.9  

LZeq  61.8  56.8  46.8  46.7  49.1  55.5  49.4  47.5  56.2  69.0  75.3  79.4  75.2  70.7  72.7  76.7  78.8  79.0  79.2  78.6  81.3  78.5  75.2  70.5  70.9  70.0  67.2  68.2  63.6  62.7  57.5  57.4  53.7  51.8  47.8  53.9 

我已經有一個代碼：

Public koef_k As Double 

Private Sub Open_Click() 

Dim myFile As Variant, koef_k As Integer 
myFile = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _ 
      "Select file") 
If myFile = False Then Exit Sub 

Open myFile For Input As #1 
row_number = 0 

Do Until EOF(1) 
Line Input #1, LineFromFile 

LineItems = Split(LineFromFile, vbTab) 

Range("C9").Offset(row_number, 0).Value = LineItems(1) 

row_number = row_number + 1 

Loop 

Close #1 

End Sub 

它像這個工程的數據格式：

Band[Hz] LZFmax     
50  51     
63  58     
80  60     
100  61     
125  63     
160  65     
200  66     
250  69     
315  73     
400  67     
500  65     
630  62     
800  60     
1000 58     
1250 55     
1600 51     
2000 48     
2500 42     
3150 39     
4000 36 
5000 32 

如何修改這個代碼，它將讀取只有LZFmax線，並通過從50到5000Hz的頻帶[Hz]列？

目前，我發現了部分解決方案

Private Sub Open_Click() 
    Dim fn As Variant, myLine As Long, txt As String, i As Integer, x 
    fn = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _ 
      "Open File") 
    If fn = False Then Exit Sub 
    myLine = 111 '<- change to suite 
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll 
    x = Split(txt, vbTab) 
    'MsgBox x(myLine + 1) 
    row_number = 0 
    Range("C9").Offset(row_number, 0).Value = x(myLine - 10) 
    i = 10 
    Do While i < 31 
    Cells(i, "C").Value = x(myLine) 
    i = i + 1 
    myLine = myLine + 1 
    Loop 
Close #1 
End Sub 

此代碼的工作，因爲我想，只有MYLINE值不是很方便，因爲我不得不手動找到它。 也許有更好的方法來優化此代碼？

Answer 1

所以我把你的原始數據作爲輸入，不得不修改它讓我有點工作。我修正了一些事情，結束了這段代碼：

Private Sub Open_Click() 
    Dim fn As Variant, myLine As Long, txt As String 
    Dim i As Integer, x As Variant, y As Variant, z As Variant, c As Variant 
    Dim sht As Worksheet 
    Set sht = Worksheets("Tabelle1") 'EDIT 
    fn = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _ 
      "Open File") 
    If fn = False Then Exit Sub 
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll 
    x = Split(txt, vbNewLine) 
    For i = 0 To UBound(x) 
     If Left(x(i), 4) = "Band" Then 
      y = x(i) 
     ElseIf Left(x(i), 6) = "LZFmax" Then 
      z = x(i) 
      Exit For 
     End If 
    Next i 
    y = Replace(y, " ", " ") 
    y = Split(y, " ") 
    z = Replace(z, " ", " ") 
    z = Split(z, " ") 
    c = 2 
    For i = 0 To UBound(y) 
     If y(i) <> "" And y(i) <> "[Hz]" And y(i) <> "Band" Then 
      sht.Cells(c, 3).Value = y(i) 
      c = c + 1 
     End If 
    Next i 
    c = 1 
    For i = 0 To UBound(z) 
     If z(i) <> "" Then 
      sht.Cells(c, 4).Value = z(i) 
      c = c + 1 
     End If 
    Next i 
    sht.Range("C1").Value = "Band [Hz]" 
Close #1 
End Sub 

林不知道，你打算如何安排Excel中的數據，但我只是印在規模和數據兩列。它在文本文件中搜索正確的行（剪切每行的第一個字母並進行比較），並將數據排列在兩個數組中（而不是一個，因爲格式化，它們具有不同的長度）並將其打印出來。第一行的標題被分成兩個元素，所以我忽略了它們，並在稍後添加了標題，以使其不那麼難看。下面是輸出：

Answer 2

下面應該給你想要的結果。

Sub GetDataFromFile() 
    Dim colIndex As Long 
    Dim LineText As String 
    Dim bandArr, LZFMaxArr, arr 
    Dim fn As Variant 
    'Open "C:\Users\Shiva\Desktop\t1.txt" For Input As #24 
    fn = Application.GetOpenFilename("Text Files (*.txt),*.txt", , _ 
      "Open File") 
    If fn = False Then Exit Sub 
    Open fn For Input As #24 
    colIndex = 1 
    While Not EOF(24) 
     Line Input #24, LineText 
      If colIndex = 1 Then 'condition for Band Column 
       arr = Split(CStr(LineText), " ") 
       bandArr = GetArray(arr) 
      ElseIf colIndex = 5 Then 'condition for LZFMax Column 
       arr = Split(CStr(LineText), " ") 
       LZFMaxArr = GetArray(arr) 
      End If 
      colIndex = colIndex + 1 
    Wend 
    Close #24 

    Dim rIndex As Long 
    rIndex = 2 
    'display headers 
    ActiveSheet.Cells(1, 1).Value = bandArr(1) 
    ActiveSheet.Cells(1, 2).Value = LZFMaxArr(1) 
    'display column value where 50<=Band<=5000 
    For j = 2 To UBound(bandArr) 
     If bandArr(j) >= 50 And bandArr(j) <= 5000 Then 
      ActiveSheet.Cells(rIndex, 1).Value = bandArr(j) 
      ActiveSheet.Cells(rIndex, 2).Value = LZFMaxArr(j) 
      rIndex = rIndex + 1 
     End If 
    Next j 
End Sub 

Private Function GetArray(arr As Variant) 
    Dim destArr(), tempArr() As String 
    Dim rowIndex, index As Long 
    Dim temp As String 
    temp = "" 
    rowIndex = 1 
    For j = 1 To UBound(arr) 
     If Not arr(j - 1) = vbNullString Then 
      'add column values in a atring 
      temp = temp & "," & arr(j - 1) 
     End If 
    Next j 
    tempArr = Split(temp, ",") 

    ReDim destArr(LBound(tempArr) To UBound(tempArr)) 
    For index = LBound(tempArr) To UBound(tempArr) 
     'assign comma separated values to array 
     destArr(index) = tempArr(index) 
    Next index 

    GetArray = destArr 
End Function 

這是我從上面的代碼得到的輸出。

讓我知道，如果有什麼不明確。