チェックマークを入力するマクロ

2017–05–30 (Tue) 15:10
チェックマークを入力するマクロです。
人によっては重宝するのではと思います。

Sub チェックマークを入力するマクロ()
For Each Target In Selection
If InStr(Target.Value, "□") = 1 Then  '先頭が□の場合に置換
Target.Value = Replace(Target.Value, "□", "R")
Target.Characters(Start:=1, Length:=1).Font.Name = "Wingdings 2"

ElseIf InStr(Target.Value, "□") <> 0 Then  '先頭以外に□がある場合に置換
Target.Value = Replace(Target.Value, "□", "R", , 1)
Target.Characters(Start:=InStr(Target.Value, "R"), Length:=1).Font.Name = "Wingdings 2"

Else  '先頭にチェックマークを付す
Target.Value = "R" & Target.Value
Target.Characters(Start:=1, Length:=1).Font.Name = "Wingdings 2"
End If

Next
End Sub

スポンサーサイト

シート名を置換するするマクロ

2017–05–30 (Tue) 08:49
シート名を置換する簡単かつ大切なマクロです。

Sub シート名を置換する()
buf2 = InputBox(Prompt:="検索する文字列")
Dim ws As Worksheet, myFind As String, myReplace As String
myFind = InputBox(Prompt:="置換後の文字列")
Application.ScreenUpdating = False
For Each ws In activeworkbook.Worksheets
On Error Resume Next
If InStr(ws.Name, buf2) <> 0 Then
If ws.Name <> buf2 Then
ws.Name = Replace(ws.Name, buf2, myFind)
End If
End If
Next ws



Application.ScreenUpdating = True
End Sub

スタイルを削除する

2017–05–29 (Mon) 11:10
スタイルを削除するマクロです。
EXCEL2010対応です。

Sub delstyle()
Application.ScreenUpdating = False
kazu = activeworkbook.Styles.count
If kazu > 47 Then
Dim s
On Error Resume Next
For Each s In activeworkbook.Styles
If Not s.BuiltIn Then
s.Delete
End If
Next
End If
Application.ScreenUpdating = True
End Sub

枠線マクロ

2017–05–28 (Sun) 14:25
今回は「枠線マクロ」を紹介します。

Sub 枠の表示()
With CommandBars("Worksheet Menu Bar").Controls("枠の表示")
waku = .list(.ListIndex)
End With

If waku = "格子" Then
Selection.Borders.LineStyle = xlContinuous
End If

If waku = "外枠" Then
Selection.BorderAround Weight:=xlMedium
End If

If waku = "普通外枠・細中枠" Then
Selection.Borders().Weight = xlHairline
Selection.BorderAround Weight:=xlThin
Selection.Borders(xlEdgeTop).Weight = xlThin
Selection.Borders(xlEdgeLeft).Weight = xlThin
End If

If waku = "上線" Then
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
End If

If waku = "下線" Then
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
End If

If waku = "左線" Then
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
End If

If waku = "右線" Then
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
End If

If waku = "縦中線" Then
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
End If

If waku = "横中線" Then
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End If

If waku = "枠無し" Then
Selection.Borders.LineStyle = False
End If

End Sub

※ 細中枠以外は全て「罫線」をクリックした際の太さになっています。
このマクロは、アドインを使って、リボン(Excel2010以降対応している?)に表示されるマクロとなります。

このマクロと併せて使用します。

201703031138426a0.png

このマクロはコンボボックスが登場します。

Sub コンボボックス作成()
Dim myWsMenu As CommandBar, myCombo As CommandBarComboBox
Set myWsMenu = Application.CommandBars("Worksheet Menu Bar")
Set myCombo = myWsMenu.Controls.Add _
(Type:=msoControlComboBox, Temporary:=True)

Dim waku As CommandBarComboBox
Set waku = myWsMenu.Controls.Add _
(Type:=msoControlComboBox, Temporary:=True)
waku.Caption = "枠の表示"
waku.AddItem "格子"
waku.AddItem "外枠"
waku.AddItem "普通外枠・細中枠"
waku.AddItem "上線"
waku.AddItem "下線"
waku.AddItem "左線"
waku.AddItem "右線"
waku.AddItem "縦中線"
waku.AddItem "横中線"
waku.AddItem "枠無し"
waku.Style = msoComboLabel
waku.OnAction = "枠の表示"
End Sub

Sub 枠の指定
Selection.Borders.LineStyle = xlContinuous
Selection.Borders.LineStyle = xlContinuous
End Sub

Selection.Borders.LineStyle を変更すれば、太さなども簡単に変更できます!

201703031138428a8.png

20170303113844850.png

201703031138451f8.png

それではまたb

最終行と最終行列の削除

2017–05–27 (Sat) 15:21
「最終行と最終行列の削除」
重宝するマクロの一つです!

Sub 最終行と列の削除()
With ActiveSheet.UsedRange
MRow = .Rows(.Rows.count).Row
MCol = .Columns(.Columns.count).Column
End With

With ActiveSheet.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With

For i = 1 To MaxCol
If Cells(MaxRow, i).MergeCells Then
If MaxRow < Cells(MaxRow, i).MergeArea.Rows.count - 1 + MaxRow Then
MaxRow = Cells(MaxRow, i).MergeArea.Rows.count - 1 + MaxRow
End If
End If
Next

For i = 1 To MaxRow
If Cells(i, MaxCol).MergeCells Then
If MaxCol < Cells(i, MaxCol).MergeArea.Columns.count - 1 + MaxCol Then
MaxCol = Cells(i, MaxCol).MergeArea.Columns.count - 1 + MaxCol
End If
End If
Next

If Cells(MaxRow, MaxCol).MergeCells Then
If MaxRow < Cells(MaxRow, MaxCol).MergeArea.Rows.count - 1 + MaxRow Then
MaxRow = Cells(MaxRow, MaxCol).MergeArea.Rows.count - 1 + MaxRow
End If
If MaxCol < Cells(MaxRow, MaxCol).MergeArea.Columns.count - 1 + MaxCol Then
MaxCol = Cells(MaxRow, MaxCol).MergeArea.Columns.count - 1 + MaxCol
End If
End If

If MRow - MaxRow <> 0 Then
ActiveSheet.Rows(MaxRow + 1 & ":" & MRow).select
Dim rc As Integer
rc = MsgBox("選択した箇所を削除しますか?", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
ActiveSheet.Rows(MaxRow + 1 & ":" & MRow).Delete

End If

End If
If MCol - MaxCol <> 0 Then
rc = MsgBox("選択した箇所を削除しますか?", vbYesNo + vbQuestion, "確認")
ActiveSheet.Columns(MaxCol + 1).Resize(, MCol).select
If rc = vbYes Then
ActiveSheet.Columns(MaxCol + 1).Resize(, MCol).Delete

End If

End If
End Sub

年度の表示

2017–05–27 (Sat) 10:12
=edate(日付セル,-3)
3ヶ月引くことで年度表示が簡単にできます。

日付の表示

違うところが一目で分かる条件付き書式

2017–05–26 (Fri) 10:27
違うところが一目で分かる条件付き書式
無題-3

無題

-2

=INDIRECT("Sheet1!"&ADDRESS(ROW(),COLUMN()))<>A1

"Sheet1!"部分にはシート名を入れ、書式にいれます。

-4


違うところが一目で分かる条件付き書式.pdf

印刷マクロまとめ

2017–05–25 (Thu) 11:00
Sub 印刷範囲を設定し一枚で印刷する()
Dim Insatsu_Cell As Range
Set Insatsu_Cell = Application.InputBox(Prompt:="印刷範囲を選択してください。", Type:=8)
ActiveSheet.PageSetup.PrintArea = Insatsu_Cell
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveSheet.PrintOut
End Sub

印刷設定をするボックスが出てきます。
選択してOKを押すと自動で印刷できます。
凄く楽で重宝しています。

Sub 一括印刷
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

最適化

2017–05–24 (Wed) 16:50
最適化マクロ

最適化マクロのPDFを作成いたしました。

最適化マクロ(PDF)

非表示のワークシートを削除する

2017–05–23 (Tue) 08:33
Sub 非表示のワークシートを削除する
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If s.Visible = xlSheetHidden Then s.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 | HOME |  次へ »

プロフィール

あゆみ

Author:あゆみ
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク