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