Sub メール作成()
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim w As Worksheet
Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("到着メール")
Set ws2 = wb1.Worksheets("テンプレ")
Set ws3 = wb1.Worksheets("置換パターン")
Set ws4 = wb1.Worksheets("通信回線一覧")
'------機器回線 列 分析
ws4.Select
ws4_lastcol = ws4.Cells(1, Columns.Count).End(xlToLeft).Column
For j = 1 To ws4_lastcol
ws4_line = ws4.Cells(1, j).Value
'MsgBox ws4_line
Select Case ws4_line
Case "機器名"
c_機器名 = j
Case "回線番号"
c_回線番号 = j
Case "拠点名"
c_拠点名 = j
End Select
Next j
'------- 置換行 分析
ws3.Select
ws3_lastrow = ws3.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To ws3_lastrow
ws3_line = ws3.Cells(i, 1).Value
Select Case ws3_line
Case "★拠点名"
r_拠点名 = i
Case "★機器"
r_機器 = i
Case "★日時_start_jst_日本語"
r_日時_start_jst_日本語 = i
Case "★日時_start_utc_日本語"
r_日時_start_utc_日本語 = i
Case "★日時_end_jst_日本語"
r_日時_end_jst_日本語 = i
Case "★日時_end_utc_日本語"
r_日時_end_utc_日本語 = i
Case "★日時_start_jst_英語"
r_日時_start_jst_英語 = i
Case "★日時_start_utc_英語"
r_日時_start_utc_英語 = i
Case "★日時_end_jst_英語"
r_日時_end_jst_英語 = i
Case "★日時_end_utc_英語"
r_日時_end_utc_英語 = i
Case "★停止時間"
r_停止時間 = i
Case "★キャリア名"
r_キャリア名 = i
End Select
Next i
'----- 到着メール 分析
ws1.Select
ws1_lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ws1_lastrow
ws1_preline = ws1.Cells(i - 1, 1).Value
ws1_line = ws1.Cells(i, 1).Value
If ws1_preline Like "*■回線名*" Then
For k = 1 To ws4.Cells(Rows.Count, 1).End(xlUp).Row
If ws4.Cells(k, c_回線番号) = ws1_line Then
ws3.Cells(2, 2).Value = ws4.Cells(k, c_機器名).Value
ws3.Cells(1, 2).Value = ws4.Cells(k, c_拠点名).Value
End If
Next k
End If
If ws1_line Like "*にて通信*" Then
t1 = Split(ws1_line, "社")
ws3.Cells(12, 2).Value = t1(0)
End If
If ws1_line Like "*最大*分*" Then
t1 = Split(ws1_line, "にて")
t2 = Split(t1(0), "分")
ws3.Cells(11, 2).Value = t2(0)
MsgBox t2(0)
End If
If ws1_preline Like "*■日程*" Then
Dim c As Date
Dim bc As Date
str1 = ws1_line
day1 = Split(str1, "-")
'MsgBox day1(0)
'MsgBox r_日時_start_jst_日本語
' MsgBox " " & Trim(day1(0)) & " (JST)"
ws3.Cells(r_日時_start_jst_日本語, 2).Value = " " & Trim(day1(0)) & " (JST)"
ws3.Cells(r_日時_end_jst_日本語, 2).Value = " " & Trim(day1(1)) & " (JST)"
'MsgBox ws3.Cells(r_日時_start_jst_日本語, 2)
d2 = Split(day1(0), "(")
d3 = Split(day1(0), ")")
dd2 = d2(0)
tt2 = d3(1)
c = dd2 & " " & tt2
c2 = c
c = DateAdd("h", -9, c)
cy = WeekdayName(Weekday(c), True)
e = Split(c, " ")
If UBound(e) = 0 Then
e = c & " 00:00"
f = c
g = Split(f, "/")
f2 = "00:00"
h = " " & Format(f, "yyy") & "年" & Format(f, "mm") & "月" & Format(f, "dd") & "日(" & cy & ")" & " " & "00" & "時" & "00" & "分" & " (UTC)"
Else
f = e(0)
g = Split(f, "/")
f2 = e(1)
g2 = Split(f2, ":")
h = " " & Format(f, "yyyy") & "年" & Format(f, "mm") & "月" & Format(f, "dd") & "日(" & cy & ")" & " " & Format(f2, "hh") & "時" & Format(f2, "nn") & "分" & " (UTC)"
End If
ws3.Cells(r_日時_start_utc_日本語, 2).Value = h
ws3.Cells(r_日時_start_jst_英語, 2).Value = Format(c2, "yyyy/mm/dd hh:nn") & " (JST)"
ws3.Cells(r_日時_start_utc_英語, 2).Value = Format(c, "yyyy/mm/dd hh:nn") & " (UTC)"
bd2 = Split(day1(1), "(")
bd3 = Split(day1(1), ")")
bdd2 = bd2(0)
btt2 = bd3(1)
bc = bdd2 & " " & btt2
bc2 = bc
bc = DateAdd("h", -9, bc)
bcy = WeekdayName(Weekday(bc), True)
be = Split(bc, " ")
If UBound(be) = 0 Then
be = bc & " 00:00"
bf = bc
bg = Split(bf, "/")
bf2 = "00:00"
bh = " " & Format(bf, "yyy") & "年" & Format(bf, "mm") & "月" & Format(bf, "dd") & "日(" & bcy & ")" & " " & "00" & "時" & "00" & "分" & " (UTC)"
Else
bf = be(0)
bg = Split(bf, "/")
bf2 = be(1)
bh = " " & Format(bf, "yyyy") & "年" & Format(bf, "mm") & "月" & Format(bf, "dd") & "日(" & bcy & ")" & " " & Format(bf2, "hh") & "時" & Format(bf2, "nn") & "分" & " (UTC)"
End If
ws3.Cells(r_日時_end_utc_日本語, 2).Value = bh
ws3.Cells(r_日時_end_jst_英語, 2).Value = Format(bc2, "yyyy/mm/dd hh:nn") & " (JST)"
ws3.Cells(r_日時_end_utc_英語, 2).Value = Format(bc, "yyyy/mm/dd hh:nn") & " (UTC)"
End If
Next i
'----- テンプレを置換
ws2_lastrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
ws3_lastrow = ws3.Cells(Rows.Count, 1).End(xlUp).Row
For m = 1 To ws2_lastrow
str1 = ws2.Cells(m, 1).Value
' ws2.Cells(i, 2).Value = ws2.Cells(i, 1).Value
For j = 1 To ws3_lastrow
ws2.Cells(m, 2).Value = Replace(ws2.Cells(m, 2).Value, ws3.Cells(j, 1).Value, ws3.Cells(j, 2).Value)
Next j
Next m
End Sub