ExcelVBAで文字列編集後別シートのセルにコピーしたいのですが

質問

Excel2000を使用しています。作業中のブックのSheet1の後ろに別のファイルをコピーすることができました。そこから（コピーできたファイル）から文字列を編集してSheet1の特定のセルに貼り付けたいのですが、未熟者でできません。以下の操作をVBAマクロで実行したいのですが解る方教えてください。

(1)コピーしたファイルのA4セルにある文字列をMID(A4,6,10)で取り出しSheet1のB21セルに貼り付ける。（日付）

(2)(1)が日付なのでそれから曜日を取得し、Sheet1のE21に表示する。

(3)コピーしたファイルのA5セルにある文字列をMID(A5,8,1)で取り出し（一桁の数字）1の時は福岡、2の時は佐賀、3の時は長崎、4の時は熊本、5の時は大分、6の時は宮崎、7の時は鹿児島、8の時は沖縄とSheet1のB24セルに表示する。

(4)コピーしたファイルのA6セルにある文字列をMID(A6,8,2)で取り出し（二桁までの数字）その後ろに"本"をつけてSheet1のB24セルに表示するB28に表示する。例）12本

(5)コピーしたファイルのA2セルにある文字列をMIDB(A2,20,6)で取り出し（時刻）Sheet1のE30セルに表示させる。

(6)コピーしたファイルのA12セルにある文字列をMID(A12,11,5)で取り出し（時刻）Sheet1のE34セルに表示させる。

(7)(6)の15分前の時刻をE36セルに表示させる。

よろしくお願いいたします。

回答No.1

GRIGO · ベストアンサー

Sheet1が１シート目、コピーしたファイルが２シートめの場合のみですが…
動かしてないのできちんと動くかは不明…
動かない場合は勉強もかねて、いろいろいじってください。
特に１５分減算の部分はもっとスマートな方法がありそう。

Private Sub YattukeSigoto()
Dim strDate As String
Dim strYoubi As String
Dim strKen As String
Dim strSetKen As String
Dim strTime1 As String
Dim strTime2 As String
Dim strTime3 As String
Dim intHour As Integer
Dim intMin As Integer

With Sheets(2)
strDate = Mid(.Range("A4"), 6, 10)
strYoubi = WeekdayName(Weekday(.Range("A4")))
strKen = Mid(.Range("A5"), 8, 1)

Select Case strKen
Case "1"
strSetKen = "福岡"
Case "2"
strSetKen = "佐賀"
Case "3"
strSetKen = "長崎"
Case "4"
strSetKen = "熊本"
Case "5"
strSetKen = "大分"
Case "6"
strSetKen = "宮崎"
Case "7"
strSetKen = "鹿児島"
Case "8"
strSetKen = "沖縄"
Case Else
MsgBox "県コードが正しくありません"
End Select

strCNT = Mid(.Range("A6"), 8, 2) & "本"
strTime1 = Mid(.Range("A2"), 20, 6)
strTime2 = Mid(.Range("A12"), 11, 5)

If IsNumeric(Left(strTime2, 2)) = True And _
IsNumeric(Right(strTime2, 2)) = True Then
If Int(Right(strTime2, 2)) < 15 Then
intMin = 60 - (15 - Int(Right(strTime2, 2)))
If Int(Left(strTime2, 2)) = 0 Then
intHour = 23
Else
intHour = Int(Left(strTime2, 2)) - 1
End If
Else
intHour = Int(Left(strTime2, 2))
intMin = Int(Right(strTime2, 2)) - 15

End If
If intHour < 10 Then
strTime3 = "0" & intHour & ":"
Else
strTime3 = intHour & ":"
End If

If intMin < 10 Then
strTime3 = strTime3 & ":" & "0" & intMin
Else
strTime3 = strTime3 & ":" & intMin
End If

Else
MsgBox "入力された時刻が正しくありません"
strTime3 = "--:--"

End If

End With

With Sheets(1)
.Range("B21") = strDate
.Range("E21") = strYoubi
.Range("B24") = strSetKen
.Range("B28") = strCNT
.Range("E21") = strTime1
.Range("E34") = strTime2
.Range("E36") = strTime3

End With

End Sub

お礼

迅速な回答ありがとうございます。自分でもできるバグ処理を行い、試したところ2つほどエラーが出て悩んでます。
(1)strYoubi = WeekdayName(Weekday(.Range("A4")))の箇所で「型が一致しません」と出て手詰まり。

(2)(1)の一文をとりあえず削除して続行させると、１５分減算の部分で表示が16：：05と表示される。（：が一つ多い）

上記2点修正できませんか？

補足

その後手直しをした結果完璧にできました。
感謝感激です。ありがとうございました。