[[20170428073723]]　『動きが遅いマクロ』（ひで）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『動きが遅いマクロ』（ひで）

出席簿の中に文字や斜線を入れるマクロなのですが，
「病欠」「事故欠」「出停」などを作って実行すると
文字や斜線が入るのが遅いのです。

セル外枠に罫線も入れるのですが，
最終的には5行毎に太線を入れるため
罫線は引き直さないといけませんので，
ここでの罫線は余り重要ではありません。

外枠の罫線を引くマクロを無くし，文字だけにすれば少しは早く入力になるのでしょうか。

マクロ初心者なのでよろしくお願いします。

ひで
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Sub kesseki()
’病欠

    ActiveCell.FormulaR1C1 = "△"
        With Selection.Font
        '.Name = "ＭＳ Ｐゴシック"
        '.FontStyle = "太字"
        '.Size = 12
       ' .Strikethrough = False
       ' .Superscript = False
       ' .Subscript = False
       ' .OutlineFont = False
       ' .Shadow = False
       ' .Underline = xlUnderlineStyleNone
       .ColorIndex = 2
       ' .TintAndShade = 0
       ' .ThemeFont = xlThemeFontMinor
       End With
    With Selection.Borders(xlDiagonalDown)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlHairline
    End With
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
'    Selection.Borders(xlInsideVertical).LineStyle = xlNone
'    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

***********************************************************************

Sub jikoketu()
'
' 事故欠 Macro
'

Call mojikeshi

 ActiveCell.FormulaR1C1 = "□"
        With Selection.Font
        '.Name = "ＭＳ Ｐゴシック"
        '.FontStyle = "太字"
        '.Size = 12
       ' .Strikethrough = False
       ' .Superscript = False
       ' .Subscript = False
       ' .OutlineFont = False
       ' .Shadow = False
       ' .Underline = xlUnderlineStyleNone
       .ColorIndex = 2
       ' .TintAndShade = 0
       ' .ThemeFont = xlThemeFontMinor
       End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
 '   Selection.Borders(xlInsideVertical).LineStyle = xlNone
 '   Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

********************************************************************

Sub chikoku()
'
' 遅刻 Macro
'

'

    ActiveCell.FormulaR1C1 = "○"
        With Selection.Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "太字"
        .Size = 12
       ' .Strikethrough = False
       ' .Superscript = False
       ' .Subscript = False
       ' .OutlineFont = False
       ' .Shadow = False
       ' .Underline = xlUnderlineStyleNone
       .ColorIndex = 1
       ' .TintAndShade = 0
       ' .ThemeFont = xlThemeFontMinor
    End With
    With Selection
     .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
     End With

     'Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlHairline
      '  .ColorIndex = 0
       ' .TintAndShade = 0
       ' .Weight = xlThin
    End With
    'With Selection.Borders(xlEdgeLeft)
     '   .LineStyle = xlContinuous
      '  .ColorIndex = 0
       ' .TintAndShade = 0
       ' .Weight = xlThin
    'End With
    'With Selection.Borders(xlEdgeTop)
     '   .LineStyle = xlContinuous
      '  .ColorIndex = 0
       ' .TintAndShade = 0
        '.Weight = xlHairline
    'End With
    'With Selection.Borders(xlEdgeBottom)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlHairline
'    End With
'    With Selection.Borders(xlEdgeRight)
'        .LineStyle = xlContinuous
'        .ColorIndex = 0
'        .TintAndShade = 0
'        .Weight = xlThin
'    End With
'    Selection.Borders(xlInsideVertical).LineStyle = xlNone
'    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
Sub shuttei()
'
' 出席停止 Macro
     With Selection.Font
      .ColorIndex = 3
      End With
     With Selection
     .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
     End With

     ActiveCell.FormulaR1C1 = "テ"

  '   Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  '  With Selection.Borders(xlDiagonalUp)
  '      .LineStyle = xlContinuous
   ' End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
 '       .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
  '      .ColorIndex = xlAutomatic
  '      .TintAndShade = 0
        .Weight = xlHairline
    End With
   ' Selection.Borders(xlInsideVertical).LineStyle = xlNone
   ' Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

End Sub

***********************************************************************

Sub kibiki()
'
' 忌引き Macro

     With Selection.Font
      .ColorIndex = 3
     End With
     With Selection
     .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
     End With
      ActiveCell.FormulaR1C1 = "キ"
 ' Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  '  With Selection.Borders(xlDiagonalUp)
  '      .LineStyle = xlContinuous
   ' End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
 '       .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
  '      .ColorIndex = xlAutomatic
  '      .TintAndShade = 0
        .Weight = xlHairline
    End With
   ' Selection.Borders(xlInsideVertical).LineStyle = xlNone
   ' Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

**********************************************************************

Sub shusseki()
'出席
' shuttei Macro

    ActiveCell.FormulaR1C1 = " "

End Sub

Sub soutai()
'
' 早退 Macro
'

'

    ActiveCell.FormulaR1C1 = "ハ"
   With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "太字"
        .Size = 11
        .ColorIndex = 1
    End With

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
     '   .WrapText = False
      '  .Orientation = 0
       ' .AddIndent = False
      '  .IndentLevel = 0
      '  .ShrinkToFit = False
      '  .ReadingOrder = xlContext
      '  .MergeCells = False
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
 With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
 '       .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
  '      .ColorIndex = xlAutomatic
  '      .TintAndShade = 0
        .Weight = xlHairline
    End With
   ' Selection.Borders(xlInsideVertical).LineStyle = xlNone
   ' Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

*********************************************************************

Sub chikokusoutai2()
'
' 遅刻早退 Macro
'

'

    ActiveCell.FormulaR1C1 = "○ハ"

    With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "太字"
        .Size = 12
       .ColorIndex = 1
       '.Color = -16776961
    End With
    With ActiveCell.Characters(Start:=2, Length:=1).Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "太字"
        .Size = 9
        .ColorIndex = 1
        '.Color = -16776961

    End With
       With Selection
        .VerticalAlignment = xlBottom
        .HorizontalAlignment = xlRight
        .WrapText = True
     End With

    With Selection.Font
          .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
 '       .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
  '      .ColorIndex = xlAutomatic
  '      .TintAndShade = 0
        .Weight = xlHairline
    End With
   ' Selection.Borders(xlInsideVertical).LineStyle = xlNone
   ' Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

***********************************************************************

Sub tennyu()
'
' 転入 Macro
'

'

    ActiveCell.FormulaR1C1 = "入"
   With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "太字"
        .Size = 11
        .ColorIndex = 1
        '.Color = -16776961
    End With

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
     '   .WrapText = False
      '  .Orientation = 0
       ' .AddIndent = False
      '  .IndentLevel = 0
      '  .ShrinkToFit = False
      '  .ReadingOrder = xlContext
      '  .MergeCells = False
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
 With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
 '       .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
  '      .ColorIndex = xlAutomatic
  '      .TintAndShade = 0
        .Weight = xlHairline
    End With
   ' Selection.Borders(xlInsideVertical).LineStyle = xlNone
   ' Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

*********************************************************************

Sub tenshutsu()
'
' 転出 Macro
'

'

    ActiveCell.FormulaR1C1 = "出"
   With ActiveCell.Characters(Start:=1, Length:=1).Font
        .Name = "ＭＳ Ｐゴシック"
        .FontStyle = "太字"
        .Size = 11
       .ColorIndex = 1
       '.Color = -16776961
    End With

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
     '   .WrapText = False
      '  .Orientation = 0
       ' .AddIndent = False
      '  .IndentLevel = 0
      '  .ShrinkToFit = False
      '  .ReadingOrder = xlContext
      '  .MergeCells = False
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
 With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
 '       .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
 '       .ColorIndex = xlAutomatic
'        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
  '      .ColorIndex = xlAutomatic
  '      .TintAndShade = 0
        .Weight = xlHairline
    End With
   ' Selection.Borders(xlInsideVertical).LineStyle = xlNone
   ' Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞

---

ひでさん

多分、出勤簿のある場所を選んでおいて、ボタンか何かをおして、マクロを走らせていらっしゃるのでしょうが、だとすれば、どこが遅いのかよくわかりません。
または、一度に一月分の出勤簿を作る、というお話なんでしょうか？
だとしたら、頂いたマクロだけでは足りない気がしますが...
（パオ〜〜ン） 2017/04/28(金) 13:47

---

とりあえず一個触って飽きてしまった

Sub kesseki()

With ActiveCell

    .FormulaR1C1 = "△"
    .Font.ColorIndex = 2
    .Borders(xlDiagonalDown).LineStyle = xlContinuous
    .Borders(xlDiagonalDown).Weight = xlHairline
    .Borders(xlDiagonalUp).LineStyle = xlContinuous
    .Borders(xlDiagonalUp).Weight = xlHairline
    .Borders.LineStyle = xlContinuous
    .Borders.Weight = xlHairline

End With

End Sub

＞＞ActiveCell.FormulaR1C1 = "△"
とあるので単一のセルに対する処理と思ってます、違ったらごめんなさい。
私ならマクロではなく入力規則と条件付き書式でやります。
（名無し） 2017/04/28(金) 14:30

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.