Excel Macro宏 - 指定路径下两个TXT文件Copy后，导入Excel中并进行对比

标签：

由于Excel格式粘贴没时间，只写关键的VBA代码和TXT文档Format示例‘

Attribute VB_Name = "CopyAndDiffer"

‘2015/06/24 ADD By MAOUIZAYOI

Option Explicit

‘ Excute Interface.
Sub CopyAndDiffer()

    ‘ define variables
    Dim ccnSht As Object       ‘ccnSht is named for current console sheet.
    Dim pathRng As Range
    Dim fileNameRng As Range
    Dim fieldsRng As Range
    Dim aRng As Range
    Dim bRng As Range

    Dim itemFilter, strPath, strFileInfo, endMark, fiA, fiB, strInput, strData, pathFilter, strTmpPath, strTmpFn As String

    Dim parentPath As String

    Dim i, j As Long
    
    ‘ initialize values
    Set ccnSht = ActiveSheet.UsedRange
    Set pathRng = ccnSht.Range("A2")
    Set fileNameRng = ccnSht.Range("B2")
    Set fieldsRng = ccnSht.Range("C2")
    Set aRng = ccnSht.Range("D2")
    Set bRng = ccnSht.Range("F2")
    
    itemFilter = ":"
    pathFilter = "Path:"
    strPath = "Path"
    strFileInfo = "FileName"
    endMark = "END"
    
    parentPath = FindParentPath
    
    fiA = parentPath & "\src\a.txt"
    fiB = parentPath & "\src\b.txt"

    i = 1
    j = 2
    
    ‘ main handle
    ‘ Loop1 to deal with result of fiB
    Open fiA For Input As #1
    Do While Not EOF(1)
    
        ‘one row data from TXT file
        Line Input #1, strInput
        
        strData = strInput


            If InStr(strData, pathFilter) > 0 Then
                Dim strLine1(0 To 1) As String
                strLine1(0) = strPath
                strLine1(1) = Split(strData, pathFilter)(1)
                
                
                If strLine1(0) = strPath Then

                    ‘ path cell name pair value.
                    Cells(j, pathRng.Column) = strLine1(1)
                    
                    strTmpPath = strLine1(1)
                End If
            Else
                Dim strLine2() As String
                strLine2 = Split(strData, itemFilter)

                If strLine2(0) = strPath Then

                    ‘ path cell name pair value.
                    Cells(j, pathRng.Column) = strLine2(1)
                    
                    strTmpPath = strLine2(1)
                ElseIf strLine2(0) = strFileInfo Then

                    ‘ fileName cell name pair value.
                    Cells(j, fileNameRng.Column) = strLine2(1)
                    
                    strTmpFn = strLine2(1)
                ElseIf strLine2(0) = endMark Then

                    ‘ a file info group is over, evaluating next group rowNo.
‘                    j = j + 1
                Else

                    ‘ field cell name pair value.
                    Cells(j, pathRng.Column) = strTmpPath
                    Cells(j, fileNameRng.Column) = strTmpFn
                    Cells(j, fieldsRng.Column) = strLine2(0)
                    Cells(j, aRng.Column) = strLine2(1)
                    
                    j = j + 1
                End If
            End If

        i = i + 1
    Loop
    Close #1

    i = 1
    j = 2
    strTmpPath = ""
    strTmpFn = ""

    ‘ Loop2 to deal with result of b
    Open fiB For Input As #1
    Do While Not EOF(1)
    
        ‘one row data from TXT file
        Line Input #1, strInput
        
        strData = strInput


            If InStr(strData, pathFilter) > 0 Then
                Dim strLine3(0 To 1) As String
                strLine3(0) = strPath
                strLine3(1) = Split(strData, pathFilter)(1)
                
                
                If strLine3(0) = strPath Then

‘                    ‘ path cell name pair value.
‘                    Cells(j, pathRng.Column) = strLine3(1)
                    
                    strTmpPath = strLine3(1)
                End If
            Else
                Dim strLine4() As String
                strLine4 = Split(strData, itemFilter)

                If strLine4(0) = strPath Then

‘                    ‘ path cell name pair value.
‘                    Cells(j, pathRng.Column) = strLine4(1)
                    
                    strTmpPath = strLine4(1)
                ElseIf strLine4(0) = strFileInfo Then

‘                    ‘ fileName cell name pair value.
‘                    Cells(j, fileNameRng.Column) = strLine4(1)
                    
                    strTmpFn = strLine4(1)
                ElseIf strLine4(0) = endMark Then

                    ‘ a file info group is over, evaluating next group rowNo.
‘                    j = j + 1
                Else

                    ‘ field cell name pair value.
‘                    Cells(j, pathRng.Column) = strTmpPath
‘                    Cells(j, fileNameRng.Column) = strTmpFn
‘                    Cells(j, fieldsRng.Column) = strLine4(0)
                    Cells(j, bRng.Column) = strLine4(1)
                    
                    j = j + 1
                End If
            End If

        i = i + 1
    Loop
    Close #1

End Sub

‘ To find ParentPath of Excel
Function FindParentPath()
    Dim curPath As String
    Dim temp As Integer
    Dim strPos As Integer
    
    curPath = ThisWorkbook.Path
    
    For temp = Len(curPath) To 1 Step -1
        strPos = InStr(temp, curPath, "\", vbTextCompare)
        If strPos <> 0 Then
            Exit For
        End If
    Next temp
    
    FindParentPath = Mid(curPath, 1, strPos - 1)
End Function

------------------------------------------------------------------------------

Txt file format e.g.

Path:D:\work\test.jpg
FileName:test.jpg
param1:1
....
END
next item info
...
END

Excel Macro宏 - 指定路径下两个TXT文件Copy后，导入Excel中并进行对比

标签：

原文地址：http://www.cnblogs.com/cnblgKingZone/p/4599990.html