ぱそこんサービス(PC service)
 
客様の満足度を第一に考え、より安く! 無料のオープンソース自由に活用。     2

 

重複チェック介護者マクロ

Sub 全実行()
'
' Macro1 Macro  重複チェック介護者原本2
' マクロ記録日 : 2006/8/18  ユーザー名 : iAza
'                2008/9/17
' 08/10/17(金) 12:03 Check2.2
' 09/11/17(火) 16:39 Ch3.1
' 11/07/13(水) 12:27 振替手当

'
'  余分な書式削除
    Columns("X:AA").Select
    Selection.Delete Shift:=xlToLeft
' 塗りつぶし解除
    Cells.Select
    Selection.Interior.ColorIndex = xlNone

' シート全体の書式(MS P明朝)
    Cells.Select
    With Selection.Font
        .Name = "MS P明朝"
    End With

'各項目の横幅
    Columns("A:A").Select
    Selection.ColumnWidth = 2
    Columns("B:B").Select
    Selection.ColumnWidth = 7.5
    Columns("E:E").Select
    Selection.ColumnWidth = 8
    Columns("F:F").Select
    Selection.ColumnWidth = 7
    Columns("G:G").Select
    Selection.ColumnWidth = 9
    Columns("H:H").Select
    Selection.ColumnWidth = 4.5
    Columns("I:K").Select
    Selection.ColumnWidth = 6
    Columns("L:L").Select
    Selection.ColumnWidth = 8
    Columns("M:N").Select
    Selection.ColumnWidth = 4
    Columns("O:W").Select
    Selection.ColumnWidth = 7
    Columns("R:R").Select
    Selection.ColumnWidth = 6

' ID;非表示
    Columns("C:D").Select
    Selection.EntireColumn.Hidden = True

' 縮小表示
    Columns("B:F").Select
    With Selection
        .ShrinkToFit = True
    End With
    Columns("H:L").Select
    With Selection
        .ShrinkToFit = True
    End With


' 日付の書式形式
    Columns("G:G").Select
    Selection.NumberFormatLocal = "m""月""d""日"";@"
'  項目名称入力
    Range("G1").Select
    ActiveCell.FormulaR1C1 = ""

' 時間の書式形式(分類)
    Columns("I:J").Select
    Selection.NumberFormatLocal = "h:mm;@"

' 時間の桁数
    Columns("K:K").Select
    Selection.NumberFormatLocal = "0.00_ "

' * 泊まり
'  ダミー用列作成:
    Columns("L:N").Select
    Selection.Insert Shift:=xlToRight
    Range("M2").Select
'  ダミー列に仮データ
    Columns("K:K").Select
    Selection.Copy
    Columns("M:M").Select
    ActiveSheet.Paste
'  ダミーを式で置き換え
    Range("M1").Select
    Selection.ClearContents
    Range("M2").Select
'=IF(OR(H2>I2,H2=I2),1,0)             * 24時間は泊まり         2008/9/17
    ActiveCell.CurrentRegion.FormulaR1C1 = "=IF(OR(RC[-4]>RC[-3],RC[-4]=RC[-3]),1,0)"
'  項目名称入力
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "泊まり"
'  ダミー列削除
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft

' * 整合チェック
'  ダミー用列作成:
    Columns("M:N").Select
    Selection.Insert Shift:=xlToRight
    Range("N2").Select
'  ダミー列に仮データ
    Columns("K:K").Select
    Selection.Copy
    Columns("N:N").Select
    ActiveSheet.Paste
'  ダミーを式で置き換え
    Range("N1").Select
    Selection.ClearContents
    Range("N2").Select


' 置き換える結果式  * 泊まりの次の日の重複をチェック
' 09/11/17(火) 11:42  ねっとdeネ! 浅井 泉
' =IF(OR(AND(G1=G2,E1=E2,L1=1),AND(G3=G2,E3=E2,L2=1)),"泊済",
'  IF(OR(AND(G1=G2,E1=E2,J1>I2),AND(G3=G2,E3=E2,I3<J2)),"重複",
'  IF(OR(AND(E1=E2,(G1=1)=G2,L1=1,J1>I2),AND(E2=E3,(G2+1)=G3,L2=1,I3<J2)),"重複",IF(AND(E1=E2,(G1+1)=G2,M1="泊済"),"要CK",""))))

' 置き換える式
    ActiveCell.CurrentRegion.FormulaR1C1 = "=IF(OR(AND(R[-1]C[-7]=RC[-7],R[-1]C[-9]=RC[-9],R[-1]C[-2]=1),AND(R[1]C[-7]=RC[-7],R[1]C[-9]=RC[-9],RC[-2]=1)),""泊済"",IF(OR(AND(R[-1]C[-7]=RC[-7],R[-1]C[-9]=RC[-9],R[-1]C[-4]>RC[-5]),AND(R[1]C[-7]=RC[-7],R[1]C[-9]=RC[-9],R[1]C[-5]<RC[-4])),""重複"",IF(OR(AND((R[-1]C[-7]+1)=RC[-7],R[-1]C[-9]=RC[-9],R[-1]C[-2]=1,R[-1]C[-4]>RC[-5]),AND((R[1]C[-7]-1)=RC[-7],R[1]C[-9]=RC[-9],RC[-2]=1,R[1]C[-5]<RC[-4])),""重複"",IF(AND((R[-1]C[-7]+1)=RC[-7],R[-1]C[-9]=RC[-9],R[-1]C=""泊済""),""要CK"",""""))))"

' 色つけ
    Range("A1:AA1").Select
    Selection.Interior.ColorIndex = 43

'  項目名称入力
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Ck4.0"
    Selection.Interior.ColorIndex = 35
    
'  ダミー列削除
    Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("N:N").Select
    Selection.Delete Shift:=xlToLeft

' 泊まり;非表示
    Columns("L:L").Select
    Selection.EntireColumn.Hidden = True

' 縦幅変更
    Cells.Select
    Selection.RowHeight = 25
    
' 見出しに罫線(下線)
    Range("A1:Y1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
    
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    

' 一行おきに色を付ける
    Range("B3:Y3").Select
    Selection.Interior.ColorIndex = 20
    Range("B2:Y3").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
' 金額欄カンマ付け
    Columns("Q:Y").Select
    Selection.NumberFormatLocal = "#,##0_ "

' 時間小数点表示
    Columns("T:T").Select
    Selection.NumberFormatLocal = "G/標準"


' チェック欄に罫線
    Columns("M:M").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDash
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDash
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

    
' 自動幅変更
    Columns("Q:Y").EntireColumn.AutoFit

' 項目行を固定
    Range("A2").Select
    ActiveWindow.FreezePanes = True

' 印刷設定
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&A"
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.196850393700787)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.196850393700787)
        .FooterMargin = Application.InchesToPoints(0.196850393700787)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 95
        .PrintErrors = xlPrintErrorsDisplayed
    End With

' オートフィルタ
    Range("A1:Y1").Select
    Selection.AutoFilter
    
' マウスポイント移動
    Range("A2").Select

End Sub