目次
入力規則で半角英数字とハイフンのみ許可する
・半角英数字とハイフンのみ
・10文字以内
データの入力規則 > ユーザー設定で数式に以下を設定。
=AND(COUNT(INDEX(FIND(MID(B6&REPT(" ",10),ROW($1:$10),1),"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-"),))=LEN(B6),LENB(B6)<11)
エラーメッセージのタイトル
半角英数10文字以内でご記入ください。
と本文。
半角英数・ハイフンを使用して10文字以内でご記入ください。
印刷用に行の高さを調整するマクロ
EXCELで印刷するとはみ出して切れてたからキレた - けむけむの 明日から本気出す！
今日は、面倒くさい表をExcelでゴリゴリ作った。できたできた。印刷しちゃえ。ふんふんふーん。ん？んん？んんん？画面で見たら綺麗なのに印刷したら、はみ出して切れ...
lzq.cocolog-nifty.com
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
www.moug.net
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(ハーツネット)のパソコントラブル解決法。起動しない、保存できない、画面がおかしいなど、パソコンのトラブルをキーワードやエラーメッセージから検...
soft1.jp
メールアドレスのみ抽出する
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)