Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Home Premium : Excel 2010)
日付判定について
投稿日時: 17/08/12 16:07:39
投稿者: Pathfinder

 先日、質問させていただいた者です。連投ですみません。
 
 先日、Simple様のアドバイスによりユーザーフォームからSheet1→各支社シートへの同じ内容を入力する
といった内容のVBAを拙いながら完成1歩前まで作成できました。
 
 皆様のお知恵をお借りしたいのは、真中あたりで前回登録した日付と今回登録する日付の連続性を確認す
るIf分を入れているのですが、日付が同じであってもMsgBoxが出てしまい、それを回避しようと式を入れ替
えたりしてみたのですが直すことが出来ません。
 
 宜しくお願い致します。
 
Private Sub CommandButton1_Click()
 Dim st1 As Worksheet
 Dim st2 As Worksheet
 Dim Area As Range
 Dim FoundCell As Range
 Dim r As Long
 Dim lrow As Long, lrow2 As Long
 Dim ListNo As Long
 Dim Ctrl As Control
  
     Set st1 = Worksheets("Sheet1")
        ListNo = ListBox1.ListIndex
            If ListNo < 0 Then
                MsgBox "会社を選択してください"
                Exit Sub
            End If
            If KeyCode = vbKeyTab Or KeyCode = vbKeyReturn Then
            TextBox2.Activate
            End If
      Set Area = st1.Range("B3:AW" & st1.Range("B" & Rows.Count).End(xlUp).Row)
         Set FoundCell = Area.Find(What:=ListBox1.Text, LookIn:=xlValues)
 
            If FoundCell Is Nothing Then '該当セルが見つからなければメッセージを表示して処理を終了する
                 MsgBox "見つかりません"
      Exit Sub
   End If
             
         With Worksheets("Sheet1")
            lrow = FoundCell.End(xlToRight).Column
             
          If Controls("TextBox1").Value <> .Range(Cells(FoundCell.Row, lrow).Address).Value Then
           
       → r = MsgBox("バックアップ日付が前後していますが、続けますか?", vbYesNo + vbCritical)
       ここの部分で同じ日であってもMsgBoxが出てしまいます。
     
           If r = vbYes Then
            .Range(Cells(FoundCell.Row, lrow + 1).Address).Value = Controls("TextBox1").Value
            .Range(Cells(FoundCell.Row, lrow + 3).Address).Value = Controls("TextBox3").Value
             
        Set st2 = Worksheets(ListBox1.Text)
          With st2
           lrow2 = .Range("B" & Rows.Count).End(xlUp).Row + 1
           .Range("B" & lrow2).Value = Controls("TextBox1").Value
           .Range("C" & lrow2).Value = Controls("TextBox3").Value
           .Range("E" & lrow2).Value = Controls("TextBox3").Value
           Sheets("Sheet1").Range("d1").Copy _
           Destination:=st2.Range("D" & lrow2)
            
      MsgBox "登録完了"
            
        End With
                
           Else
           Exit Sub
             
        End If
         End If
          End With
             
        For Each Ctrl In Controls
          If TypeName(Ctrl) = "TextBox" Then _
             Ctrl.Value = ""
        Next Ctrl
 End Sub

回答
投稿日時: 17/08/12 17:33:08
投稿者: simple

 If Controls("TextBox1").Value <> .Range(Cells(FoundCell.Row, lrow).Address).Value Then
 とあります。後者は、単に .Cells(FoundCell.Row, lrow).Value と書いた方がよいでしょう。
  
 (1) Controls("TextBox1").Value は 文字列です。 例えば、"2017/8/12" のような文字列そのものです。
 (2) 一方、 Cells(FoundCell.Row, lrow).Valueは日付型データですから、
    表示は 2017/8/12でも、実体は日付を表すシリアル値です。
    .Valueプロパティをとると、それは Date型の値ですから、基本は数値です。
    ( Cells(FoundCell.Row, lrow).Value2 のように Value2プロパティを使うと、
       42959などと表示されるはずです。特定の日からの連番が振られているのです。)
  
 ですから、比較しても一致はしません。
  
 一致させるには、
 例えばTextプロパティを使う方法があります。
 If Controls("TextBox1").Value <> .Cells(FoundCell.Row, lrow).Text Then
   
 (これは、Cells(FoundCell.Row, lrow)の表示が 2017/8/12という形式で、
   テキストボックスに入れているのと同じ種類のものという前提です。)
 
 トライしてみてください。
 
 なお、インデントをもう少しきちんとつけたほうがいいでしょう。
 それは他人のためでなく、ご自分のためにです。
  

Private Sub CommandButton1_Click()
    Dim st1 As Worksheet
    Dim st2 As Worksheet
    Dim Area As Range
    Dim FoundCell As Range
    Dim r As Long
    Dim lrow As Long, lrow2 As Long
    Dim ListNo As Long
    Dim Ctrl As Control

    Set st1 = Worksheets("Sheet1")
    
    ListNo = ListBox1.ListIndex
    If ListNo < 0 Then
        MsgBox "会社を選択してください"
        Exit Sub
    End If
    
    If keyCode = vbKeyTab Or keyCode = vbKeyReturn Then
        TextBox2.Activate
    End If
    
    Set Area = st1.Range("B3:AW" & st1.Range("B" & Rows.Count).End(xlUp).Row)
    
    Set FoundCell = Area.find(What:=ListBox1.Text, LookIn:=xlValues)

    If FoundCell Is Nothing Then    
        MsgBox "見つかりません"
        Exit Sub
    End If

    With Worksheets("Sheet1")
        lrow = FoundCell.End(xlToRight).Column

        If Controls("TextBox1").Value <> .Cells(FoundCell.Row, lrow).Value Then
            If r = vbYes Then
                .Cells(FoundCell.Row, lrow + 1).Value = Controls("TextBox1").Value
                .Cells(FoundCell.Row, lrow + 3).Value = Controls("TextBox3").Value

                Set st2 = Worksheets(ListBox1.Text)
                With st2
                    lrow2 = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    .Range("B" & lrow2).Value = Controls("TextBox1").Value
                    .Range("C" & lrow2).Value = Controls("TextBox3").Value
                    .Range("E" & lrow2).Value = Controls("TextBox3").Value
                    Sheets("Sheet1").Range("d1").Copy _
                            Destination:=st2.Range("D" & lrow2)
                    MsgBox "登録完了"
                End With
            Else
                Exit Sub
            End If
        End If
    End With

    For Each Ctrl In Controls
        If TypeName(Ctrl) = "TextBox" Then Ctrl.Value = ""
    Next Ctrl
End Sub
一部変更していますが、殆ど同じものです。

回答
投稿日時: 17/08/12 22:24:34
投稿者: WinArrow
投稿者のウェブサイトに移動

質問者(Pathfinder)さんへ
 
掲示のコードは、回答者側ではコンパイルエラーがでて動作しません。
 
未定義変数
KeyCode
未定義メソッド
TextBox2.Activate・・・・Excel2010からは使えるのかしら?
 
 
コードを掲示する場合、少なくとも回答者側で動作するコードを掲示してください。
回答者側で再現できないと回答が付かなくなる可能性があります。
また、前回のトピとの続き(又は関連)でしたら、リンクを貼ってください。
 
コードを掲示する場合、インデントをキチンとつけて下さい。
非常に読みにくいです。
※今回の場合、未定義菜変数があるため、テストする気にもなりません。
 
ずいぶんと回りくどい(わかりにくい)コーディングしますね・・・
>Controls("TextBox1").Value
こんな書き方しなくても
TextBox1.Value
でよいでしょう。
敢えて言うならば
Me.TextBox1.Value
の書き方をお勧めします。
 
コードに統一性がない
>Set st1 = Worksheets("Sheet1")
と記述しておいて
なぜ、
>With Worksheets("Sheet1")
がでてくるのかな?
 
また、
シート名で修飾しているにもかかわらず、
>.Range(Cells(FoundCell.Row, lrow + 1).
は、NGです
.Range(.Cells(FoundCell.Row, lrow + 1).

投稿日時: 17/08/14 00:48:47
投稿者: Pathfinder

Simple様
 
返事が遅くなり申し訳ありません。
大変わかりやすく、かつ的確なアドバイスをまたしてもいただきありがとうございます。
勉強不足を痛感しております。
自分なりにコードは整理していたつもりでしたが、Simple様の整理していただいたコード
を見させていただき、非常に参考になりました。
VBAを勉強し始めたばかりですが、職場にはまだまだ非効率なルーティンワークが残って
いるためSimple様の助言をいただけたことでより勉強していきたいと思えました。
 
自分が思うような動作が、出来上がると達成感が違います!
また、躓きましたら相談させていただきます。
この度は、本当にありがとうございました。