Question

我一直在尝试寻找一个将合并多个.CSV文件的宏。但是，我在所述文件中需要的数据（GPS数据）位于A列的不同行中。因此，我需要它来搜索字符串的一部分，在这种情况下，有一些与GPS相关的字符串，但是我只需要GPS纬度和经度（将总是一个接一个地找到）。

感谢您的帮助！该代码可能看起来有点..像狗屎一样，我一直在尝试弄乱它，使其协同工作！

Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim directory As Object
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim S_Lat, S_Long, D_Lat, D_Long As Range




Dim i As Integer
Dim icount As Integer
Dim icount2 As Integer



Application.ScreenUpdating = False
Application.DisplayAlerts = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = -1 Then '-1 = yes or true
        FolderPath = .SelectedItems(1) & "\"
        Else
        MsgBox "FilePath not selected!", , "Path selecter"
        Exit Sub
    End If

End With
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)


' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 2

' Call Dir the first time, pointing it to all .csv files in the folder path.
FileName = dir(FolderPath & "*.csv")


SummarySheet.Range("A1") = "Filnamn"
SummarySheet.Range("B1") = "Latitud"
SummarySheet.Range("C1") = "Longitud"



' Loop until Dir returns an empty string.
Do While FileName <> ""

    ' Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & "\" & FileName)

    ' Set the cell in column A to be the file name.
    SummarySheet.Range("A" & NRow).Value = FileName

    ' Set the source range to be A9 through C9.
    ' Modify this range for your workbooks.
    ' It can span multiple rows.

    For i = 1 To 200
        If InStr(1, LCase(Range("A" & i)), "GPS Latitude") <> 0 Then 'If GPS appears in the string then
            icount = i
            icount2 = icount + 1

            Set S_Lat = WorkBk.Worksheets(1).Range("A" & icount) ' Set the S_Lat variable
            Set S_Long = WorkBk.Worksheets(1).Range("A" & icount2) ' Set the S_Long variable

            Exit For

        End If
    Next i








    ' Set the destination range to start at column B and
    ' be the same size as the source range.

   '  SummarySheet.Range("B" & NRow).Value = S_Lat.Value  ***** Didnt work? ******
   '  SummarySheet.Range("C" & NRow).Value = S_Long.Value ***** Didnt work? ******

    Set D_Lat = SummarySheet.Range("B" & NRow)
    Set D_Long = SummarySheet.Range("C" & NRow)


    ' Copy over the values from the source to the destination.

    D_Lat.Value = S_Lat.Value
    D_Long.Value = S_Long.Value



    ' Increase NRow so that we know where to copy data next.
    NRow = NRow + D_Lat.Rows.Count

    ' Close the source workbook without saving changes.
    WorkBk.Close savechanges:=False

    ' Use Dir to get the next file name.
    FileName = dir()
Loop

' Call AutoFit on the destination sheet so that all
' data is readable.
' SummarySheet.Columns.AutoFit

结束子

Answer 1

这个简单的代码没有为您提供完整的工作宏，它将在A列中查找“纬度”，并且在找到时会将cel.value和其下方的cel.value并排传输到两行侧在同一工作表的B列和C列中。您需要将其包装在Workbooks.Open循环中，修改源工作表中的Range以包括最后一行，为新工作簿的工作表包括最后一行，并将其添加到If内部的代码中声明。尝试将其用于代码中，遇到问题时，您可以返回SO并询问有关宏的特定问题。将该宏与实际的经度和纬度进行了测试，在A列中并排放置在B列和C列中。

Dim lRow As Long
lRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

For Each cel In Range("A1:A38")
    If InStr(1, cel.Value, "Latitude") Then
        x = x + 1
            Cells(x, 2).Value = cel.Value
            Cells(x, 3).Value = cel.Offset(1).Value
    End If
Next cel

“操作搜索和合并”：VBA

1 个答案: