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的Band [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

这是我从上面的代码得到的输出。

如果有什么不清楚，请告诉我。

Excel VBA：从txt文件中读取特定行到选定的列范围

2 个答案: