Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

7714 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

【37257】メッセージボックスの出し方 福神漬 06/4/27(木) 11:17

【37258】Re:メッセージボックスの出し方 Statis 06/4/27(木) 11:33

【37260】Re:メッセージボックスの出し方 福神漬 06/4/27(木) 12:34

【37261】Re:メッセージボックスの出し方 Statis 06/4/27(木) 12:58

【37265】Re:メッセージボックスの出し方 福神漬 06/4/27(木) 13:41

【37288】Re:メッセージボックスの出し方 Statis 06/4/28(金) 8:04

【37300】Re:メッセージボックスの出し方 福神漬 06/4/28(金) 14:29

【37303】Re:メッセージボックスの出し方 Statis 06/4/28(金) 14:45

【37307】Re:メッセージボックスの出し方 福神漬 06/4/28(金) 15:39

【37308】Re:メッセージボックスの出し方 Statis 06/4/28(金) 15:49

【37259】Re:メッセージボックスの出し方 Kein 06/4/27(木) 11:40

【37266】Re:メッセージボックスの出し方 福神漬 06/4/27(木) 13:43


	【37257】メッセージボックスの出し方

福神漬 - 06/4/27(木) 11:17 -


	引用なし

	パスワード

昨日はありがとうございました。
オートフィルタの複数条件で抽出するコードを作りました。
抽出データがないときにメッセージボックスで"抽出データはありません"
と表示したいのですが、下のコードではメッセージボックスが出てきませんでした。
どこに入れればメッセージボックスは出てきますか？
ご教授下さい。
　　　　　　
　　　　　　If IsDate(Me.TextBox1.Value) And IsDate(Me.TextBox2.Value) Then
　　　　　　Da1 = Format(Me.TextBox1.Value, .Range("BG6").NumberFormat)
　　　　　　Da2 = Format(Me.TextBox2.Value, .Range("BG6").NumberFormat)
　　　　　　　　If AutoFilterMode = False Then
　　　　　　　　　　With .Range("M3:BG" & r2)
　　　　　　　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
　　　　　　　　　　Criteria2:="<=" & Da2
　　　　　　　　　　End With
　　　　　　　　　　With .Range("M3:BG" & r2)
　　　　　　　　　　.AutoFilter field:=1, Criteria1:="=保守*"
　　　　　　　　　　End With
　　　　　　　　　　.Range("B4:K" & r2).Copy
　　　　　　　　　　With ThisWorkbook.Worksheets("保守期限一覧表").Range("B5")
　　　　　　　　　　.PasteSpecial xlValues
　　　　　　　　　　End With
　　　　　　　　　　.Range("M4:W" & r2).Copy
　　　　　　　　　　With ThisWorkbook.Worksheets("保守期限一覧表").Range("L5")
　　　　　　　　　　.PasteSpecial xlValues
　　　　　　　　　　End With
　　　　　　　　　　.Range("AZ4:BU" & r2).Copy
　　　　　　　　　　With ThisWorkbook.Worksheets("保守期限一覧表").Range("W5")
　　　　　　　　　　.PasteSpecial xlValues
　　　　　　　　　　End With
　　　　　　　　End If
　　　　　　Else
　　　　　　MsgBox "抽出データはありません"
　　　　　　End If


	【37258】Re:メッセージボックスの出し方

Statis - 06/4/27(木) 11:33 -


	引用なし

	パスワード

こんにちは

こんな感じかな？

If IsDate(Me.TextBox1.Value) And IsDate(Me.TextBox2.Value) Then
　 Da1 = Format(Me.TextBox1.Value, .Range("BG6").NumberFormat)
　 Da2 = Format(Me.TextBox2.Value, .Range("BG6").NumberFormat)
　 If .AutoFilterMode = False Then
　　　.Range("M3:GB3").AutoFilter
　 End If
　 With .Range("M3:BG" & r2)
　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
　　　　　　Criteria2:="<=" & Da2
　　　　.AutoFilter field:=1, Criteria1:="=保守*"
　　　　If .Range("M65536").End(xlUp).Row > 4 Then
　　　　　 .Range("B4:K" & r2).SpecialCells(xlCellTypeVisible).Copy
　　　　　　ThisWorkbook.Worksheets("保守期限一覧表").Range ("B5")
　　　　　　　　 .PasteSpecial xlValues
　　　　　　.Range("M4:W" & r2).SpecialCells(xlCellTypeVisible).Copy
　　　　　　 ThisWorkbook.Worksheets("保守期限一覧表").Range ("L5")
　　　　　　　　.PasteSpecial xlValues
　　　　　　.Range("AZ4:BU" & r2).SpecialCells(xlCellTypeVisible).Copy
　　　　　　 ThisWorkbook.Worksheets("保守期限一覧表").Range ("W5")
　　　　　　　　.PasteSpecial xlValues
　　　　　　Application.CutCopyMode = False
　　　　Else
　　　　　 MsgBox "抽出データはありません。", vbCritical
　　　　End If
　　　　.AutoFilterMode = False
　 End With
Else
　　MsgBox "テキストボックスの値が日付として確認出来ませんでした。", vbCritical
End If


	【37259】Re:メッセージボックスの出し方

Kein - 06/4/27(木) 11:40 -


	引用なし

	パスワード

Dim PsSt As Worksheet

If IsDate(Me.TextBox1.Value) And IsDate(Me.TextBox2.Value) Then
　 MsgBox "テキストボックスの値は日付として認識できません", 48
　 Exit Sub
End If
Set PsSt = ThisWorkbook.Worksheets("保守期限一覧表")
With Worksheets("管理表マスター")
　 Da1 = Format(Me.TextBox1.Value, .Range("BG6").NumberFormat)
　 Da2 = Format(Me.TextBox2.Value, .Range("BG6").NumberFormat)
　 With .Range("M3:BG" & r2)
　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, _
　　　Operator:=xlAnd, Criteria2:="<=" & Da2
　　　.AutoFilter field:=1, Criteria1:="=保守*"
　 End With
　 If .AutoFilter.Range.SpecialCells(12).Rows.Count = 1 Then
　　　MsgBox "フィルターで抽出されたデータはありません", 48
　 Else
　　　.Range("B4:K" & r2).Copy
　　　PsSt.Range("B5").PasteSpecial xlValues
　　　Application.CutCopyMode = False
　　　.Range("M4:W" & r2).Copy
　　　PsSt.Range("L5").PasteSpecial xlValues
　　　Application.CutCopyMode = Fals
　　　.Range("AZ4:BU" & r2).Copy
　　　PsSt.Range("W5").PasteSpecial xlValues
　　　Application.CutCopyMode = Fals
　 End If
　 .AutoFilterMode = False
End With
Set PsSt = Nothing

というようにします。


	【37260】Re:メッセージボックスの出し方

福神漬 - 06/4/27(木) 12:34 -


	引用なし

	パスワード

お返事ありがとうございました。
早速、試してみました。
B5へ貼り付けるところでエラーになってしまい、「オブジェクトは金プロパティまたはメソッドをサポートしていません」となってしまいます。
再度、ご教授下さい。
原因は、　　　　｜
　　　　　　　　　↓ですか？　　　
　　　　　　With WB.Worksheets("管理表マスター")'原因はここですか？
　　　　　　If IsDate(Me.TextBox1.Value) And IsDate(Me.TextBox2.Value) Then
　　　　　　Da1 = Format(Me.TextBox1.Value, .Range("BG6").NumberFormat)
　　　　　　Da2 = Format(Me.TextBox2.Value, .Range("BG6").NumberFormat)
　　　　　　　　If .AutoFilterMode = False Then
　　　　　　　　　　.Range("M3:BG3").AutoFilter
　　　　　　　　End If
　　　　　　　　With .Range("M3:BG" & r2)
　　　　　　　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
　　　　　　　　　　Criteria2:="<=" & Da2
　　　　　　　　　　.AutoFilter field:=1, Criteria1:="=保守*"
　　　　　　　　　　If WB.Worksheets("管理表マスター").Range("M65536").End(xlUp).Row > 4 Then
　　　　　　　　　　　　.Range("B4:K" & r2).SpecialCells(xlCellTypeVisible).Copy
　　　　　　　　　　　　ThisWorkbook.Worksheets("保守期限一覧表").Range ("B5")'ここでエラー
　　　　　　　　　　　　.PasteSpecial xlValues
　　　　　　　　　　　　.Range("M4:W" & r2).SpecialCells(xlCellTypeVisible).Copy
　　　　　　　　　　　　ThisWorkbook.Worksheets("保守期限一覧表").Range ("L5")
　　　　　　　　　　　　.PasteSpecial xlValues
　　　　　　　　　　　　.Range("AZ4:BU" & r2).SpecialCells(xlCellTypeVisible).Copy
　　　　　　　　　　　　ThisWorkbook.Worksheets("保守期限一覧表").Range ("W5")
　　　　　　　　　　　　.PasteSpecial xlValues
　　　　　　　　　　Application.CutCopyMode = False
　　　　　　　　　　Else
　　　　　　　　　　　　MsgBox "抽出データはありません", vbInformation
　　　　　　　　　　End If
　　　　　　　　　　WB.Worksheets("管理表マスター").AutoFilterMode = False
　　　　　　　　End With
　　　　　　Else
　　　　　　　　MsgBox "入力された値が日付として確認できませんでした", vbInformation
　　　　　　End If
　　　　　　End With


	【37261】Re:メッセージボックスの出し方

Statis - 06/4/27(木) 12:58 -


	引用なし

	パスワード

こんにちは
>ThisWorkbook.Worksheets("保守期限一覧表").Range ("B5")
>　　　　　　　　　　　　.PasteSpecial xlValues

ThisWorkbook.Worksheets("保守期限一覧表").Range("B5").PasteSpecial xlValues

>ThisWorkbook.Worksheets("保守期限一覧表").Range ("L5")
>　　　　　　　　　　　　.PasteSpecial xlValues
ThisWorkbook.Worksheets("保守期限一覧表").Range("L5").PasteSpecial xlValues

>ThisWorkbook.Worksheets("保守期限一覧表").Range ("W5")
>　　　　　　　　　　　　.PasteSpecial xlValues

ThisWorkbook.Worksheets("保守期限一覧表").Range("W5").PasteSpecial xlValues

として下さい。


	【37265】Re:メッセージボックスの出し方

福神漬 - 06/4/27(木) 13:41 -


	引用なし

	パスワード

Statisさん、ありがとうございました。
早速、試したらできました。

重ね重ねで申し訳ないのですが、コードの初めの方に↓で1度表内をデリートしています。
r1 = Range("B65536").End(xlUp).Row
Worksheets("保守期限一覧表").Range("B5：AR" & r1).ClearContents

1～4までは見出しがあり、データの初めが5行目からなのですが、
表中にデータがない状態で保存されている場合、抽出ボタンを押すと見出し部分も
消されてしまいます。
データがない場合は消さないようにしたいのですが

If Worksheets("保守期限一覧表").Range("B5：AR" & r1) < 5 Then
Worksheets("保守期限一覧表").Range("B5：AR" & r1).ClearContents
Else

↑Else以降はどうゆうコードを書けばいいでしょうか？


	【37266】Re:メッセージボックスの出し方

福神漬 - 06/4/27(木) 13:43 -


	引用なし

	パスワード

Keinさん、お返事ありがとうございました。
頂いたコード、後ほど試させて頂きたいと思います。
また、質問をさせて頂きますので、是非ご教授下さい。


	【37288】Re:メッセージボックスの出し方

Statis - 06/4/28(金) 8:04 -


	引用なし

	パスワード

こんにちは

変数「r1」は保守期限一覧表シートのB列の最終データ行を取得
しているのなら下記で良いのでは。

r1 = Range("B65536").End(xlUp).Row
If r1 > 4 Then
　 Worksheets("保守期限一覧表").Range("B5：AR" & r1).ClearContents
End If


	【37300】Re:メッセージボックスの出し方

福神漬 - 06/4/28(金) 14:29 -


	引用なし

	パスワード

お世話になっております。

昨日、ご教授頂いた時にはちゃんと抽出されていたのですが、
午前中、試してみたらコピー範囲が指定しているところと違う場所を
コピーしてしまいます。
原因が分からないのですが、ご教授頂けるでしょうか(+_+)
念の為、全コードを載せてみます。

Private Sub CommandButton1_Click()
Dim FileName As String
Dim MYPATH As String
Dim WB As Workbook
Dim r1 As Long
Dim r2 As Long
Dim Da1 As Date
Dim Da2 As Date
r1 = Range("B65536").End(xlUp).Row
If ThisWorkbook.Worksheets("保守期限一覧表").Range("B5：AR" & r1) < 5 Then
Worksheets("保守期限一覧表").Range("B5：AR" & r1).ClearContents
Else
End If
MYPATH = "\\1111\22222\出荷管理\管理表\管理表\"
strFileName = MYPATH & "管理表マスター" & ".xls"
　　If Dir(strFileName) <> "" Then
　　Set WB = Workbooks.Open(strFileName)
　　r2 = Range("D65536").End(xlUp).Row
　　　　　　With WB.Worksheets("管理表マスター")
　　　　　　If IsDate(Me.TextBox1.Value) And IsDate(Me.TextBox2.Value) Then
　　　　　　Da1 = Format(Me.TextBox1.Value, .Range("BG6").NumberFormat)
　　　　　　Da2 = Format(Me.TextBox2.Value, .Range("BG6").NumberFormat)
　　　　　　　　If .AutoFilterMode = False Then
　　　　　　　　　　.Range("M3:BG3").AutoFilter
　　　　　　　　End If
　　　　　　　　With .Range("M3:BG" & r2)
　　　　　　　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
　　　　　　　　　　Criteria2:="<=" & Da2
　　　　　　　　　　.AutoFilter field:=1, Criteria1:="=保守*"
　　　　　　　　　　If WB.Worksheets("管理表マスター").Range("M65536").End(xlUp).Row > 4 Then
　　　　　　　　　　　　.Range("B4:K" & r2).SpecialCells (xlCellTypeVisible).Copy 'B4～Kまでコピーされず

　　　　　　　　　　　　ThisWorkbook.Worksheets("保守期限一覧表").Range("B5").PasteSpecial xlValues
　　　　　　　　　　　　.Range("M4:W" & r2).SpecialCells(xlCellTypeVisible).Copy 'N4からコピーされてしまいます。
　　　　　　　　　　　　ThisWorkbook.Worksheets("保守期限一覧表").Range("L5").PasteSpecial xlValues
　　　　　　　　　　　　.Range("AZ4:BU" & r2).SpecialCells(xlCellTypeVisible).Copy
　　　　　　　　　　　　ThisWorkbook.Worksheets("保守期限一覧表").Range("W5").PasteSpecial xlValues
　　　　　　　　　　Application.CutCopyMode = False
　　　　　　　　　　Else
　　　　　　　　　　　　MsgBox "抽出データはありません", vbInformation
　　　　　　　　　　End If
　　　　　　　　　　WB.Worksheets("管理表マスター").AutoFilterMode = False
　　　　　　　　End With
　　　　　　Else
　　　　　　　　MsgBox "入力された値が日付として確認できませんでした", vbInformation
　　　　　　End If
　　　　　　End With
　　　　　　AutoFilterMode = False
　　　　　　Workbooks("管理表マスター.xls").Close savechanges:=False
　　Else
　　MsgBox strFileName & "がありません"
　　End If
　　Worksheets("保守期限一覧表").Select
　　Cells.EntireColumn.AutoFit
　　Range("A:A").Select
　　Selection.ColumnWidth = 4
　　Range("X:X").Select
　　Selection.ColumnWidth = 7.5
　　Range("Z:Z").Select
　　Selection.ColumnWidth = 7.5
　　Unload UserForm1
End Sub


	【37303】Re:メッセージボックスの出し方

Statis - 06/4/28(金) 14:45 -


	引用なし

	パスワード

こんにちは

これでどうかな？

Option Explicit

Private Sub CommandButton1_Click()
Dim FileName As String
Dim MYPATH As String
Dim WB As Workbook
Dim r1 As Long
Dim r2 As Long
Dim Da1 As Date
Dim Da2 As Date
Dim strFileName As String
With ThisWorkbook.Worksheets("保守期限一覧表")
　　 r1 = .Range("B65536").End(xlUp).Row
　　 If r1 < 5 Then
　　　　.Range("B5：AR" & r1).ClearContents
　　End If
End With
MYPATH = "\\1111\22222\出荷管理\管理表\管理表\"
strFileName = MYPATH & "管理表マスター" & ".xls"
　　If Dir(strFileName) <> "" Then
　　　 Set WB = Workbooks.Open(strFileName)
　　　 With WB.Worksheets("管理表マスター")
　　　　　　r2 = .Range("D65536").End(xlUp).Row
　　　　　　If IsDate(Me.TextBox1.Value) And IsDate(Me.TextBox2.Value) Then
　　　　　　　 Da1 = Format(Me.TextBox1.Value, .Range("BG6").NumberFormat)
　　　　　　　 Da2 = Format(Me.TextBox2.Value, .Range("BG6").NumberFormat)
　　　　　　　 If .AutoFilterMode = False Then
　　　　　　　　　.Range("M3:BG3").AutoFilter
　　　　　　　 End If
　　　　　　　 With .Range("M3:BG" & r2)
　　　　　　　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
　　　　　　　　　　　 Criteria2:="<=" & Da2
　　　　　　　　　　.AutoFilter field:=1, Criteria1:="=保守*"
　　　　　　　 End With
　　　　　　　 If .Range("M65536").End(xlUp).Row > 4 Then
　　　　　　　　　.Range("B4:K" & r2).SpecialCells(xlCellTypeVisible).Copy　'B4～Kまでコピーされず
　　　　　　　　　 ThisWorkbook.Worksheets("保守期限一覧表").Range("B5").PasteSpecial xlValues
　　　　　　　　　.Range("M4:W" & r2).SpecialCells(xlCellTypeVisible).Copy 'N4からコピーされてしまいます。
　　　　　　　　　 ThisWorkbook.Worksheets("保守期限一覧表").Range("L5").PasteSpecial xlValues
　　　　　　　　　.Range("AZ4:BU" & r2).SpecialCells(xlCellTypeVisible).Copy
　　　　　　　　　 ThisWorkbook.Worksheets("保守期限一覧表").Range("W5").PasteSpecial xlValues
　　　　　　　　　 Application.CutCopyMode = False
　　　　　　　 Else
　　　　　　　　　 MsgBox "抽出データはありません", vbInformation
　　　　　　　 End If
　　　　　　　 .AutoFilterMode = False
　　　　　　Else
　　　　　　　　MsgBox "入力された値が日付として確認できませんでした", vbInformation
　　　　　　End If
　　　　End With
　　　　Workbooks("管理表マスター.xls").Close savechanges:=False
　　Else
　　　　MsgBox strFileName & "がありません"
　　End If
　　With ThisWorkbook.Worksheets("保守期限一覧表")
　　　　 .Cells.EntireColumn.AutoFit
　　　　 .Range("A:A").ColumnWidth = 4
　　　　 .Range("X:X").ColumnWidth = 7.5
　　　　 .Range("Z:Z").ColumnWidth = 7.5
　　End With
　　Unload UserForm1
End Sub


	【37307】Re:メッセージボックスの出し方

福神漬 - 06/4/28(金) 15:39 -


	引用なし

	パスワード

Statis、お返事ありがとうございました。
いつもありがとうございます。
早速、試しました。
思い通りに動いてくれました。
オートフィルタの部分を変えて頂いたのだと思いますが、
1.と2.でどう違ってくるのかお手間にならない程度で構いませんので
教えてください。
よろしくお願い致します。

1.
　　　　　　　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
　　　　　　　　　　Criteria2:="<=" & Da2
　　　　　　　　　　.AutoFilter field:=1, Criteria1:="=保守*"
2.
　　　　　　　 With .Range("M3:BG" & r2)
　　　　　　　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
　　　　　　　　　　　 Criteria2:="<=" & Da2
　　　　　　　　　　.AutoFilter field:=1, Criteria1:="=保守*"
　　　　　　　 End With


	【37308】Re:メッセージボックスの出し方

Statis - 06/4/28(金) 15:49 -


	引用なし

	パスワード

▼福神漬さん：
こんにちは
>1.
>　　　　　　　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
>　　　　　　　　　　Criteria2:="<=" & Da2
>　　　　　　　　　　.AutoFilter field:=1, Criteria1:="=保守*"

これだけではオートフィルタの位置（セル）が判りませんね、
>2.
>　　　　　　　 With .Range("M3:BG" & r2)
>　　　　　　　　　　.AutoFilter field:=47, Criteria1:=">=" & Da1, Operator:=xlAnd, _
>　　　　　　　　　　　 Criteria2:="<=" & Da2
>　　　　　　　　　　.AutoFilter field:=1, Criteria1:="=保守*"
>　　　　　　　 End With

こちらは「With .Range("M3:BG" & r2)」で対象の位置（セル）がわかります。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

7714 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free