Excel VBA質問箱 IV

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

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


7715 / 13645 ツリー ←次へ | 前へ→

【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)」で対象の位置(セル)がわかります。

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