Excel VBA質問箱 IV

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

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


44447 / 76732 ←次へ | 前へ→

【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
2 hits

【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 お礼

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