目次
入力規則で半角英数字とハイフンのみ許可する
・半角英数字とハイフンのみ
・10文字以内
データの入力規則 > ユーザー設定で数式に以下を設定。
=AND(COUNT(INDEX(FIND(MID(B6&REPT(" ",10),ROW($1:$10),1),"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-"),))=LEN(B6),LENB(B6)<11)
エラーメッセージのタイトル
半角英数10文字以内でご記入ください。
と本文。
半角英数・ハイフンを使用して10文字以内でご記入ください。
印刷用に行の高さを調整するマクロ

EXCELで印刷するとはみ出して切れてたからキレた - けむけむの 明日から本気出す!
今日は、面倒くさい表をExcelでゴリゴリ作った。できたできた。印刷しちゃえ。ふんふんふーん。ん?んん?んんん?画面で見たら綺麗なのに印刷したら、はみ出して切れてしまって、読めんやないかーい!どないなっとんねん。と、キレちゃった経験...
Option Explicit Dim 開始明細行 As Integer Public Sub 印刷で切れるのを頑張ってみる() Dim own_sheet As Object Dim w_cnt As Long Dim x As Long ' 行の開始を決めておく 開始明細行 = 1 ' 初期値セット w_cnt = 1 For Each own_sheet In Sheets own_sheet.Activate ' シートの最終行をセット ' 各シートのC列を見てます w_cnt = own_sheet.Range("C65536").End(xlUp).Row For x = 開始明細行 To w_cnt own_sheet.Rows(x).Select If own_sheet.Cells(x, 3) <> "" Then Selection.RowHeight = ((Selection.RowHeight / 12) * 1.3) * 12 + 12 End If Next Next End Sub
マクロでテキストボックスの一括置換
使い方
シート名を「changetable」
シートの「A1」に置換前文字列
シートの「B1」に置換後文字列
AllSheet.replist ⇒全シート対象
Sheet.repilis ⇒指定の1シート対象
Set chg_sheet = Worksheets(“シート名”)
のシート名部分に置換対象のシート名を入れる
全シート対象(AllSheet.replist)
Sub replist() Dim list_sheet As Worksheet Dim chg_sheet As Worksheet Dim cnt As Integer Dim srcword As String Dim repword As String Dim txtbox As Object ' 置換する元の文字列(A列)と先の文字列(B列)のリストを作っておいて指定 Set list_sheet = Worksheets("changetable") cnt = list_sheet.Range("a1").CurrentRegion.Rows.Count Application.ScreenUpdating = False ' すべてのシートに対して処理 For Each chg_sheet In Worksheets ' リストのシートは除外 If chg_sheet.Name <> list_sheet.Name Then ' 処理対象のシートをアクティブにする chg_sheet.Select ' 置換対象のリスト数だけLoop処理 For i = 1 To cnt srcword = list_sheet.Cells(i, "A").Value repword = list_sheet.Cells(i, "B").Value ' すべてのテキストボックスに対して置換 For Each txtbox In ActiveSheet.Shapes If txtbox.Type = msoTextBox Then txtbox.DrawingObject.Text = _ Replace(txtbox.DrawingObject.Text, srcword, repword, 1, -1, vbTextCompare) End If Next Next i End If Next chg_sheet Application.ScreenUpdating = True End Sub
個別シート(Sheet.repilis)
Sub replist() Dim list_sheet As Worksheet Dim chg_sheet As Worksheet Dim cnt As Integer Dim srcword As String Dim repword As String Dim txtbox As Object ' 置換する元の文字列(A列)と先の文字列(B列)のリストを作っておいて指定 Set list_sheet = Worksheets("changetable") ' 対象シートを指定する Set chg_sheet = Worksheets("シートの名前") cnt = list_sheet.Range("a1").CurrentRegion.Rows.Count Application.ScreenUpdating = False ' 処理対象のシートをアクティブにする chg_sheet.Select ' 置換対象のリスト数だけLoop処理 For i = 1 To cnt srcword = list_sheet.Cells(i, "A").Value repword = list_sheet.Cells(i, "B").Value ' すべてのテキストボックスに対して置換 For Each txtbox In ActiveSheet.Shapes If txtbox.Type = msoTextBox Then txtbox.DrawingObject.Text = _ Replace(txtbox.DrawingObject.Text, srcword, repword, 1, -1, vbTextCompare) End If Next Next i Application.ScreenUpdating = True End Sub
シート名一覧を取得するマクロ
シート名の取得(セルと配列に格納):Excel VBA|即効テクニック|Excel VBAを学ぶならmoug
Sub sheet_name_list() Dim i As Long Dim mySheetCnt As Long Dim mySheetName As String mySheetCnt = ThisWorkbook.Sheets.Count For i = 1 To mySheetCnt mySheetName = Sheets(i).Name ActiveSheet.Cells(i, 1).Value = mySheetName Next i End Sub
セルを参照してシート名を含んだ数式を作る関数『INDIRECT』
シート名をセルで参照したい/INDIRECT関数
HEARTSNET(ハーツネット)のパソコントラブル解決法。起動しない、保存できない、画面がおかしいなど、パソコンのトラブルをキーワードやエラーメッセージから検索できます。
メールアドレスのみ抽出する
VBAでメニューの[挿入]-[標準モジュール]から以下を追加する。
Function PickupADR(文字列 As Variant) Dim re As Variant Dim Matches As Object, M As Object Dim i As Long, buf As Variant Set re = CreateObject("VBScript.RegExp") With re .Pattern = "[a-zA-Z0-9-][w-./?]*@[a-zA-Z0-9][a-zA-Z0-9-.]+.[a-zA-Z]+" 'メールアドレスのパターン .Global = True If .test(文字列) Then Set Matches = .Execute(文字列) If Matches.Count = 1 Then PickupADR = Matches(0).Value ElseIf Matches.Count > 1 Then ReDim buf(0 To Matches.Count) For Each M In Matches buf(i) = M.Value i = i + 1 Next PickupADR = buf End If End If End With End Function
以下の関数でメールアドレスを抽出できる。
=PICKUPADR(A1)