Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


41 / 13177 ツリー ←次へ | 前へ→

【79981】エラーが出てしまいます。どこを修正したらいいのでしょうか。 KAZUE 18/6/11(月) 20:53 質問[未読]
【79983】Re:エラーが出てしまいます。どこを修正し... マナ 18/6/11(月) 21:46 発言[未読]
【79986】Re:エラーが出てしまいます。どこを修正し... KAZUE 18/6/12(火) 5:56 質問[未読]
【79988】Re:エラーが出てしまいます。どこを修正し... よろずや 18/6/12(火) 8:27 発言[未読]
【79989】Re:エラーが出てしまいます。どこを修正し... KAZUE 18/6/12(火) 9:21 質問[未読]
【79990】Re:エラーが出てしまいます。どこを修正し... よろずや 18/6/12(火) 12:57 回答[未読]
【79992】Re:エラーが出てしまいます。どこを修正し... KAZUE 18/6/13(水) 8:37 発言[未読]
【79993】Re:エラーが出てしまいます。どこを修正し... KAZUE 18/6/13(水) 17:19 お礼[未読]

【79981】エラーが出てしまいます。どこを修正した...
質問  KAZUE  - 18/6/11(月) 20:53 -

引用なし
パスワード
   VBAの勉強を始めたばかりなのですが、
仕事で必要になり色々教えていただき以下のようにできたのですが、

「 '小計」の部分の「 r(i, 6) = r(i, 3) * r(i, 5)」まで来ると
実行時エラー13 型が一致しません。と出てしまいます。
ちなみに小計を出したいのは、 Set sh2 = Worksheets("明細書")の
シートなのですが、どこを修正していいのかわかりません。

どなたか、教えていただけますでしょうか。


Sub サンプル()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim sdate As String, edate As String
Dim date1 As Date, date2 As Date
Dim i As Long, imax As Long, j As Long
 Dim place As String
sdate = InputBox("開始日を yyyy/m/d の形式で入力して下さい")
If sdate = "" Then Exit Sub
If IsDate(sdate) = False Then
MsgBox "日付エラー"
Exit Sub
End If
edate = InputBox("終了日を yyyy/m/d の形式で入力して下さい")
If edate = "" Then Exit Sub
If IsDate(edate) = False Then
MsgBox "日付エラー"
Exit Sub
End If
date1 = DateValue(sdate)
date2 = DateValue(edate)
If date1 > date2 Then
MsgBox "開始日>終了日 エラー"
Exit Sub
End If
Application.ScreenUpdating = False
Set sh1 = Worksheets("作業シート")
Set sh2 = Worksheets("明細書")


'初期化
With sh1
If .Range("A1").Value <> "" Then
.Range("A5:Z" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
End If
End With
With sh2
If .Range("B7").Value <> "" Then '**
.Range("A7:J" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
  End If
End With


'抽出
With Worksheets("データ")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Range("A" & i).Value >= date1 And .Range("A" & i).Value <= date2 Then
j = j + 1
.Range("A" & i & ":X" & i).Copy Destination:=sh1.Range("A" & j)
End If
Next i
End With


'明細書作成
j = 9
With sh1
imax = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:X" & imax).Sort Key1:=.Range("C1"), Order1:=xlAscending, Key2:=.Range("A1"), order2:=xlAscending
 For i = 1 To imax
If .Range("C" & i).Value <> place Then
j = j + 3
 sh2.Range("B" & j).Value = "【" & .Range("C" & i).Value & "】"
place = .Range("C" & i).Value
 svdate = 0
End If
j = j + 1
If .Range("A" & i).Value <> svdate Then
sh2.Range("A" & j).Value = .Range("A" & i).Value
sh2.Range("A" & j).NumberFormatLocal = "m/d"
svdate = .Range("A" & i).Value
svdate = .Range("A" & i).Value
End If
sh2.Range("B" & j).Value = .Range("D" & i).Value & " No." & .Range("P" & i).Value
sh2.Range("C" & j).Value = .Range("Q" & i).Value
sh2.Range("D" & j).Value = .Range("F" & i).Value
sh2.Range("E" & j).Value = .Range("O" & i).Value
sh2.Range("F" & j).Value = .Range("X" & i).Value
sh2.Range("J" & j).Value = .Range("R" & i).Value
Next i
End With


'小計
Dim r As Range
Range("C2").Resize(2).ClearContents
With Range("B12", Cells(Rows.Count, "B").End(xlUp))
For Each r In .SpecialCells(xlCellTypeConstants).Areas
r(r.Count + 1) = "小計"
For i = 2 To r.Count
r(i, 6) = r(i, 3) * r(i, 5)
r(i, 7) = r(i, 6) * 0.08
r(i, 8) = r(i, 2) + r(i, 6) + r(i, 7)
Next
r(r.Count + 1, 2) = Application.Sum(r.Offset(, 1))
r(r.Count + 1, 6) = Application.Sum(r.Offset(, 5))
r(r.Count + 1, 7) = Application.Sum(r.Offset(, 6))
r(r.Count + 1, 8) = Application.Sum(r.Offset(, 7))
Next r
End With


Application.ScreenUpdating = True
sh2.Select
End Sub

【79983】Re:エラーが出てしまいます。どこを修正...
発言  マナ  - 18/6/11(月) 21:46 -

引用なし
パスワード
   ▼KAZUE さん:

>「 '小計」の部分の「 r(i, 6) = r(i, 3) * r(i, 5)」まで来ると
>実行時エラー13 型が一致しません。と出てしまいます。

r(i, 3) と r(i, 5)には何が入っているか
確認してみましたか。

ところで、関係ないかもしれませんが
小計のブロックだけ、シートが指定されていませんが大丈夫でしょうか。


> '小計
> Dim r As Range
> Range("C2").Resize(2).ClearContents
> With Range("B12", Cells(Rows.Count, "B").End(xlUp))

【79986】Re:エラーが出てしまいます。どこを修正...
質問  KAZUE  - 18/6/12(火) 5:56 -

引用なし
パスワード
   ▼マナ さん:
早速ありがとうございます。

r(i, 3) と r(i, 5)にカーソルを合わせると
確かに文字が表示されるのですが、実際にExcelの
画面では数値なので、そこも不明な事と、
シートの指定で「With sh2」と入れると
これもエラーになってしまってどこをどうしていいのか
困り果てている状況です。

ここで教えていただくのに
不足している物が何かありますでしょうか。

本当に初心者ですみません。

【79988】Re:エラーが出てしまいます。どこを修正...
発言  よろずや  - 18/6/12(火) 8:27 -

引用なし
パスワード
   >シートの指定で「With sh2」と入れると
どこにどう入れたのですか?

【79989】Re:エラーが出てしまいます。どこを修正...
質問  KAZUE  - 18/6/12(火) 9:21 -

引用なし
パスワード
   ▼よろずや さん:

すみません。よろしくお願いします。

'小計
 With sh2  ←ここにいれてみました
 Dim r As Range

こうすると
コンパイルエラー End With が必要です。

と出てしまい、'小計の一番下に入っているので
困ってます。

【79990】Re:エラーが出てしまいます。どこを修正...
回答  よろずや  - 18/6/12(火) 12:57 -

引用なし
パスワード
   ▼KAZUE さん:
>'小計
> With sh2  ←ここにいれてみました
> Dim r As Range
>
>こうすると
>コンパイルエラー End With が必要です。

End With は、入れ子にできます。
入れてください。
入れたら、sh2 を参照したい部分の頭にピリオドを追記しましょう。

【79992】Re:エラーが出てしまいます。どこを修正...
発言  KAZUE  - 18/6/13(水) 8:37 -

引用なし
パスワード
   ありがとうございます。
今から会社に行って試してみます。

また、結果を後程書き込みます。

▼よろずや さん:
>▼KAZUE さん:
>>'小計
>> With sh2  ←ここにいれてみました
>> Dim r As Range
>>
>>こうすると
>>コンパイルエラー End With が必要です。
>
>End With は、入れ子にできます。
>入れてください。
>入れたら、sh2 を参照したい部分の頭にピリオドを追記しましょう。

【79993】Re:エラーが出てしまいます。どこを修正...
お礼  KAZUE  - 18/6/13(水) 17:19 -

引用なし
パスワード
   会社で試してみました!
できました! ありがとうございます。
また、何かあったときに、よろしくお願いします。

>▼よろずや さん:
>>▼KAZUE さん:
>>>'小計
>>> With sh2  ←ここにいれてみました
>>> Dim r As Range
>>>
>>>こうすると
>>>コンパイルエラー End With が必要です。
>>
>>End With は、入れ子にできます。
>>入れてください。
>>入れたら、sh2 を参照したい部分の頭にピリオドを追記しましょう。

41 / 13177 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free