Excel VBA フォーム

Option Explicit

Private Sub Workbook_Open()
   Call 日記読み込み表示
End Sub

Option Explicit
Const 表示日数 As Integer = 2


Private Sub CommandButton1_Click()
   移動日数 = 移動日数 - 表示日数
   Call セルに展開  '★★★★★★★★★
End Sub

Private Sub CommandButton2_Click()
   移動日数 = 移動日数 + 表示日数
   Call セルに展開  '★★★★★★★★★
End Sub

Private Sub CommandButton3_Click()
   'ワークブックを保存しないで閉じると共にExcelを終了する
   Application.Quit
   ThisWorkbook.Close savechanges:=False           '保存せずにブックを閉じる
End Sub

Private Sub UserForm_Click()
   'ワークブックを保存しないで閉じると共にExcelを終了する
   Application.Quit
   ThisWorkbook.Close savechanges:=False           '保存せずにブックを閉じる
End Sub

Option Explicit

Dim 入力ファイル名 As String
Dim 入力行 As String
Dim 入力文字列 As String
Dim 出力行 As String
Dim 入力行文字数 As Integer
Dim 処理行カウンタ As Long
Dim 検索文字目 As Integer
Dim 日記データ(367, 4) As String '空白、一昨年、去年、今年。年間通算日は、0日〜366日
'↑日記データを、直近3年分格納する配列
Dim 今日 As Date
Dim 日付 As Date
Dim 日付部分 As String
Dim 日付部分2 As String
Dim 今年 As String
Dim 去年 As String
Dim 一昨年 As String
Dim 年数差 As Integer
Dim データ区分 As String
Dim 正規表現オブジェクト日付 As RegExp
Dim 正規表現オブジェクト区切り As RegExp
Dim 正規表現オブジェクト日と曜日 As RegExp
Dim 年間通算日 As Integer
Dim Matchオブジェクト As Object
Public 移動日数 As Integer
Dim 表示起点日数 As Integer
Dim 年月 As String


Sub 日記読み込み表示()

   Dim ファイルシステムオブジェクト As Object          ' FileSystemObject
   Dim 入力テキストストリームオブジェクト As Object    ' TextStream
   
   Set 正規表現オブジェクト日付 = New RegExp
   正規表現オブジェクト日付.Pattern = "[0-9]{4}/[0-9]{2}/[0-9]{2}\(.\)" 'YYYY/MM/DD(曜日)の形式
   '↑日付データを取得するための文字列
   Set 正規表現オブジェクト日と曜日 = New RegExp
   正規表現オブジェクト日と曜日.Pattern = "/[0-9]{2}\(.\)" '/DD(曜日)の形式

   Set 正規表現オブジェクト区切り = New RegExp
   正規表現オブジェクト区切り.Pattern = "[A-Z0-9]{19}" '3AC7269C004B39AE000 など
  '↑TextClipperは、複数のカードを、ひとつのファイルに格納します。
  'カードの区切りに、この形式の文字列があるので、これを頼りに、データを分割します。
  
   今日 = Date
   今年 = DatePart("yyyy", Date)
   年間通算日 = DateDiff("y", 今年 & "/1/1", 今日) + 1 'DateDiffで、1月1日は、0になる点に注意
   去年 = DatePart("yyyy", DateAdd("yyyy", -1, Date))
   一昨年 = DatePart("yyyy", DateAdd("yyyy", -2, Date))
   データ区分 = ""
   
   '変換対象のファイル名とパス取得
   入力ファイル名 = "D:\TextClipper\textcp7.tx" 'TextClipper のカードデータのファイル名
       
   
   '********************************
   'ファイルのオープン。
   処理行カウンタ = 0
   
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   
   ' 指定ファイルをOPEN(入力モード)
   Set 入力テキストストリームオブジェクト = _
   ファイルシステムオブジェクト.OpenTextFile(入力ファイル名, 1)


   '*************データの読み込み***********
    Do Until 入力テキストストリームオブジェクト.AtEndOfStream
      処理行カウンタ = 処理行カウンタ + 1
      
      ' レコードの読み込み
      入力行 = 入力テキストストリームオブジェクト.ReadLine
      
'      If 処理行カウンタ = 69243 Then Stop    '★デバッグ
'      If 処理行カウンタ >= 69186 Then Stop    '★デバッグ
      
      If 正規表現オブジェクト区切り.Test(入力行) Then 'カードの区切りを検出
         Set Matchオブジェクト = 正規表現オブジェクト区切り.Execute(入力行)
         
'         MsgBox Matchオブジェクト.Item(0).FirstIndex
' Stop

            入力文字列 = RTrim(Replace(Left(入力行, Matchオブジェクト.Item(0).FirstIndex), Chr(0), " "))
            入力文字列 = Replace(入力文字列, "  ", " ")
'Stop
            If データ区分 = "日記データ" Then
               If 入力文字列 <> "" Then
                  出力行 = 出力行 & vbLf & 入力文字列 'セル内改行のコードは、0A(LF)
               End If
                  
               年数差 = DateDiff("yyyy", 日付, 今日)
               出力行 = Replace(出力行, Chr(9), "：")

               Select Case 年数差
                  Case 2
                     日記データ(DateDiff("y", 一昨年 & "/1/1", 日付) + 1, 1) = 出力行
                  Case 1
                     日記データ(DateDiff("y", 去年 & "/1/1", 日付) + 1, 2) = 出力行
                  Case 0
                     日記データ(DateDiff("y", 今年 & "/1/1", 日付) + 1, 3) = 出力行
               End Select
            
               データ区分 = ""
               出力行 = ""
            End If

         日付部分 = Right(入力行, 13)
         日付部分2 = Right(入力行, 6)
                  
         If 正規表現オブジェクト日付.Test(日付部分) Then
            データ区分 = "日記データ"
            年月 = Left(日付部分, 7)

            日付 = Left(日付部分, 10)
            出力行 = 日付部分

         ElseIf 正規表現オブジェクト日と曜日.Test(日付部分2) Then
            データ区分 = "日記データ"
            日付部分 = 年月 & 日付部分2
            日付 = Left(日付部分, 10)
            出力行 = 日付部分
            
         Else
            データ区分 = ""
         End If
         
      ElseIf InStr(入力行, "薬" & vbTab) > 0 _
            And InStr(入力行, Chr(0)) > 0 Then  '文字化け行のカードの区切りを検出。Chr(0)は、null
            入力文字列 = RTrim(Left(入力行, InStr(入力行, Chr(0)) - 1))
            
            入力文字列 = Replace(入力文字列, "  ", " ")
            
            If 入力文字列 <> "" And データ区分 = "日記データ" Then
               出力行 = 出力行 & vbLf & 入力文字列 'セル内改行のコードは、0A(LF)
                  
               年数差 = DateDiff("yyyy", 日付, 今日)
               Select Case 年数差
                  Case 2
                     日記データ(DateDiff("y", 一昨年 & "/1/1", 日付) + 1, 1) = 出力行
                  Case 1
                     日記データ(DateDiff("y", 去年 & "/1/1", 日付) + 1, 2) = 出力行
                  Case 0
                     日記データ(DateDiff("y", 今年 & "/1/1", 日付) + 1, 3) = 出力行
               End Select
            
               データ区分 = ""
               出力行 = ""
            End If

      
         日付部分 = Right(入力行, 6)
         
         If 正規表現オブジェクト日と曜日.Test(日付部分) Then
            データ区分 = "日記データ"
            日付部分 = 年月 & 日付部分
            日付 = Left(日付部分, 10)
            出力行 = 日付部分
            
         Else
            データ区分 = ""
         End If
         
      ElseIf データ区分 = "日記データ" Then
 
         入力文字列 = RTrim(入力行)
'         入力文字列 = Replace(入力文字列, "  ", " ")
            If 入力文字列 <> "" Then
               出力行 = 出力行 & vbLf & 入力文字列 'セル内改行のコードは、0A(LF)
            End If
      End If
      入力文字列 = ""
      ' 最終行まで繰り返す
   Loop
   
   '**************データの読み込みを終了*********************
   
   ' 指定ファイルをCLOSE
   入力テキストストリームオブジェクト.Close
   Set 入力テキストストリームオブジェクト = Nothing
   
   Set ファイルシステムオブジェクト = Nothing
   移動日数 = 0
   
   '**************3年日記形式で、Excelのシートに表示*********************
   
   'マクロの処理日をベースに、初期表示
   Call セルに展開  '★★★★★★★★★
'Stop '★デバッグ
      
   '★★★★★ここで、ボタン操作に制御を渡す★★★★★★
    UserForm1.Show vbModeless

End Sub

Sub セルに展開()
   Dim 列 As Integer
   Dim 行 As Integer
   Dim 遡り日数 As Integer
   
   ThisWorkbook.Worksheets("日記表示").Activate
   Range("A1:C3").ClearContents
   
   表示起点日数 = 年間通算日 + 移動日数
'Stop

   For 列 = 1 To 3 '3年表示

      If 列 = 3 Then
'      Stop 'デバッグ
         If 表示起点日数 < 31 Then
            遡り日数 = 表示起点日数 - 1
         Else
            遡り日数 = 30
         End If
         表示起点日数 = 表示起点日数 - 遡り日数
      End If
         If 表示起点日数 < 1 Then
            表示起点日数 = 1
            MsgBox "これより以前には戻れません。" '1月1日以前には、さかのぼれない
         ElseIf 表示起点日数 > 365 Then
            表示起点日数 = 365
            MsgBox "これより以降には進めません。" '12月31日以降には、繰り下がれない
         End If
         
      For 行 = -1 To 0 '2日分、2行表示
      
         Range("A3").Cells(行, 列).Value = 日記データ(表示起点日数 + 行, 列)
         
      Next 行
   Next 列
   
End Sub