EXCEL-懇求各位高手們幫幫忙.(延伸版)

按此下載參考檔

Sub ExtractData()

Dim course As String, month As String, day As String, week As String

Dim courseTime As Single, beginTime As Single, endTime As Single

Dim targetRow As Long, endrow As Long, r As Long

Dim rmargin As Integer, c As Integer, i As Integer, p1 As Integer, p2 As Integer

Dim targetSht As Worksheet

Set targetSht = Sheets("行程明細")

targetRow = 3

targetSht.Rows(targetRow & ":65536").Clear

endrow = [C65536].End(xlUp).Row

rmargin = [F6].End(xlToRight).Column

r = 9

Do Until r > endrow

If Cells(r, 3) <> "" Then month = Cells(r, 3)

If Cells(r, 4) <> "" Then day = Cells(r, 4)

If Cells(r, 5) <> "" Then week = Cells(r, 5)

For c = 6 To rmargin

course = Trim(Cells(r, c))

beginTime = Cells(6, c)

endTime = Cells(8, c)

courseTime = endTime - beginTime

courseTime = Round((courseTime) * 24) / 24

If Cells(r, c).MergeCells Then

For i = Cells(r, c).MergeArea.Count - 1 To 1 Step -1

c = c + 1

endTime = Cells(8, c)

courseTime = courseTime + endTime - Cells(6, c)

courseTime = Round((courseTime) * 24) / 24

Next

End If

If course = "假日" Or course = "例假" Or course = "" Then courseTime = 0

With targetSht

.Cells(targetRow, 1) = Year(Date) & "/" & month & "/" & day

.Cells(targetRow, 2) = week

.Cells(targetRow, 4) = Format(beginTime, "hh:mm") & "～" & Format(endTime, "hh:mm")

.Cells(targetRow, 9) = courseTime * 24

p1 = InStr(course, " ")

If p1 Then .Cells(targetRow, 7) = Left(course, p1 - 1) Else .Cells(targetRow, 7) = course

p2 = InStrRev(course, " ")

If p2 Then .Cells(targetRow, 10) = Mid(course, p2 + 1) Else .Cells(targetRow, 10) = ""

End With

targetRow = targetRow + 1

Next

r = r + 1

Loop

With targetSht

.Range("A3:J" & targetRow - 1).Borders.LineStyle = 1

.Range("A:D,I:I").HorizontalAlignment = xlCenter

End With

targetSht.Select: [A3].Select

End Sub