Sub shmoo()
Dim iFilename As Variant: Dim File As String: Dim STname As String: Dim str As String
Dim XY_ray As Object
Set XY_ray = CreateObject("scripting.dictionary")
Dim Locala As Long: Dim sPath As String: Dim sName As String
Dim line As Long:
Dim Y_axis As Long: Dim X_axis As Long
iFilename = Application.GetOpenFilename("Text Files (*.txt),*.txt")
If iFilename = False Then
MsgBox ("no file have be active"), vbCritical
End If
Locala = InStrRev(iFilename, "\")
sPath = Left(iFilename, Locala)
sName = Right(iFilename, Len(iFilename) - Locala)
txtname = Dir(sPath & "*.txt")
Do While txtname <> ""
maxY = 0: Ymax = 0
If Not XY_ray.exists(txtname) Then
Set sht = Worksheets.Add(after:=Worksheets(1))
sht.Name = txtname
XY_ray.Add txtname, txtname
End If
Open sPath & "\" & txtname For Input As #1
With Worksheets(txtname)
'---------------
Do While Not EOF(1)
Line Input #1, str
line = line + 1
If line < 16 Then
strline = Split(str, Chr$(9))
If strline(1) <> "" Then
.Cells(line, 2).Value = strline(1)
.Cells(line, 4).Value = strline(3)
End If
End If
If line > 16 Then
strline = Split(str, Chr$(9))
strlinenum = UBound(strline)
If strlinenum = 10 And strline(10) = "" And strline(9) <> "" Then '媼峎ㄛ婃奀瓚剿
'===================0 17193 1 0 0 2.14 0.4 0 P
X_axis = strline(3): Y_axis = strline(4)
.Cells(2 - 1 + maxY, 8 - 1) = "site" & strline(1)
.Cells(2 - 1 + maxY, 8 - 1).Interior.ColorIndex = 6
.Cells(2 + maxY + Val(strline(4)), 8 - 1) = Val(strline(7)) ' Y_axis
.Cells(2 + maxY + Val(strline(4)), 8 - 1).Interior.ColorIndex = 44
.Cells(2 - 1 + maxY, 8 + Val(strline(3))) = Val(strline(6)) ' X_axis
.Cells(2 - 1 + maxY, 8 + Val(strline(3))).Interior.ColorIndex = 45
.Cells(2 + maxY + Val(strline(4)), 8 + Val(strline(3))).Value = strline(9)
If .Cells(2 + maxY + Val(strline(4)), 8 + Val(strline(3))).Value = "P" Then
.Cells(2 + maxY + Val(strline(4)), 8 + Val(strline(3))).Interior.ColorIndex = 4
Else
If .Cells(2 + maxY + Val(strline(4)), 8 + Val(strline(3))).Value = "F" Then
.Cells(2 + maxY + Val(strline(4)), 8 + Val(strline(3))).Interior.ColorIndex = 3
End If
End If
If Val(strline(4)) > Ymax Then Ymax = Val(strline(4))
Else
maxY = maxY + Ymax + 5
GoTo nextline
'===================
End If
If strlinenum = 11 Then '珨峎ㄛ婃奀瓚剿
End If
End If
nextline:
Loop
'---------------
End With
Close #1
line = 0
txtname = Dir
nextdir:
Loop
End Sub