由于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