Excel macro Macros-Specify the path under two TXT file copy, import and contrast in Excel

Source: Internet
Author: User
Tags file copy file info

Because the Excel format is pasted without time, write only the key VBA code and TXT document format example '

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 the 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 and 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 and 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 Macros-Specify the path under two TXT file copy, import and contrast in Excel

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.