从众多文本文件中提取多行数据并关联到Excel

时间:2017-04-15 20:15:53

标签: excel vba excel-vba

有关如何修改脚本的任何建议:

Extract a single line of data from numerous text files and import into Excel

要生成在一列中具有文件名的Excel工作表(.ini文件的文件名),第二列中的纬度和第三列中的经度?我还有一堆.ini文件,其中包含.jpg的相机参数,但需要提取Name,Lat和Long进行进一步处理。

以下是.ini文件的示例:

[top_left]
lng =  -80.5251854921
lat =   46.6276919869

[top_right]
lng =  -80.5307483620
lat =   46.6297628116

[bottom_left]
lng =  -80.5229096407
lat =   46.6307857000

[bottom_right]
lng =  -80.5281836560
lat =   46.6327636148

[center]
lng =  -80.5267096969
lat =   46.6302821844

[origin]
Xs =       319.50000
Ys =       239.50000

[map]
A00 =         0.0008197901
A01 =        -0.0085907931
A02 =       -80.5267154968
A10 =        -0.0004764527
A11 =         0.0049839176
A12 =        46.6302857603
A20 =        -0.0000102856
A21 =         0.0001067452
A22 =         1.0000000000

[frameTimestamp]
frameTs = 0

我尝试使用extract data from multiple text files in a folder into excel worksheet中的一些代码但收效甚微。

1 个答案:

答案 0 :(得分:0)

这应该可以做你想要的 - 但是没有错误处理 - 它假定每个文件都是按照你的例子中所示的方式布局的。我还假设任何一个lat / lng对都没问题,你只需要其中一个;因此,我提取了一个与' top_left'相关联的那个。此外,所有.ini文件都位于C:Temp \ Test目录中,并假定您希望在ActiveSheet的最后一行之后追加数据:

Option Explicit

Sub ExtractLatLng()
    Dim MyFolder As String, MyFile As String, textline As String
    Dim r As Integer, pos As Integer

    MyFolder = "C:\Temp\Test\"
    MyFile = dir(MyFolder & "*.ini")

    r = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row + 1
    Do While MyFile <> ""
        Open (MyFolder & MyFile) For Input As #1
        Do Until EOF(1)
          Line Input #1, textline
          pos = InStr(textline, "[top_left]")
          If pos = 1 Then
             ActiveSheet.Cells(r, "A").Value = MyFile
             Line Input #1, textline
             pos = InStr(textline, "=")
             ActiveSheet.Cells(r, "C").Value = Mid(textline, pos + 1)
             Line Input #1, textline
             pos = InStr(textline, "=")
             ActiveSheet.Cells(r, "B").Value = Mid(textline, pos + 1)
             r = r + 1
             Exit Do
          End If
        Loop
        Close #1
        MyFile = dir()
    Loop 
End Sub