2022年5月17日火曜日

【マクロ】置換

Sub sample()

Dim myCell As Variant

Application.ScreenUpdating = False

myCell = Range("M2", Cells(Rows.Count, "M").End(xlUp))


For i = 1 To UBound(myCell, 1)

str0 = myCell(i, 1)

str0 = Replace(str0, "1", "A", compare:=vbTextCompare)

str0 = Replace(str0, "2", "b", compare:=vbTextCompare)

str0 = Replace(str0, "3", "C", compare:=vbTextCompare)

str0 = Replace(str0, "4", "d", compare:=vbTextCompare)

str0 = Replace(str0, "0", "X", compare:=vbTextCompare)

myCell(i, 1) = str0

Next

Range("M2", Cells(Rows.Count, "M").End(xlUp)) = myCell

Application.ScreenUpdating = True

End Sub



----------------------------------------------------------------------------

東京(  )区・市、埼玉、千葉、神奈川、その他

このような記入方法で入力された住所を置換する。

○○市や〇〇区は東京、東京は東京、埼玉は埼玉、千葉は千葉・・・

H列の値をO列に返している。


Public Sub 住所置換()

Application.ScreenUpdating = False

Dim rg As Range

Dim r As Range

Set rg = Range("H2:H" & Cells(Rows.Count, "A").End(xlUp).Row)

For Each r In rg

If Right(r.Value, 1) = "区" Or Right(r.Value, 1) = "市" Then

r.Offset(, 7).Value = "東京"

Else

r.Offset(, 7).Value = r.Value

End If

Next

Application.ScreenUpdating = True

End Sub








2022年5月9日月曜日

【マクロ】セルをダブルクリックして実行

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

 

    '■特定セルで起動する場合(セルE10)

    If Target.Address = "$E$10" Then

        MsgBox "特定セル"

    End If

    '■特定セル範囲で起動する場合(セルのC4~E5)

    If Not Intersect(Target, Range("C4:E5")) Is Nothing Then

        MsgBox "特定セル範囲"

    End If

     

    '■特定列で起動する場合(B列(2列目)の場合)

    If Target.Column = 2 Then

        MsgBox "特定列"

    End If

     

    '■特定行で起動する場合(1行目の場合)

    If Target.Row = 1 Then

        MsgBox "特定行"

    End If

     '■Trueにするとダブルクリック(セルの編集状態)はキャンセルされます

    '■Falseにするとダブルクリック(セルの編集状態)になります

    Cancel = True

End Sub

2022年3月24日木曜日

【作業中のディスプレイにユーザーフォームを表示させる方法】


フォームモジュールを右クリックしコード表示をして下記のコードを書き込む


Sub UFPositionCenter(UFOb As Object)

  '**ユーザーフォームを親ウィンドウの中央に表示する

  '参考

  'https://dz11.hatenadiary.jp/entry/2019/05/17/090258

  '標準モジュールではMeが使えないので、ユーザーフォーム側にて引数として呼び出す


  '**変数(T=Top,L=Left,W=Width,H=Height,AW=ActiveWindow,UF=UserForm)

  Dim T_AW As Long, L_AW As Long, W_AW As Long, H_AW As Long

  Dim T_UF As Long, L_UF As Long, W_UF As Long, H_UF As Long

  

  '**親ウィンドウの位置とサイズを取得

  With ActiveWindow

    T_AW = .Top

    L_AW = .Left

    W_AW = .Width

    H_AW = .Height

  End With

  

  '**UFのサイズを取得

  W_UF = UFOb.Width

  H_UF = UFOb.Height


  '**UFの表示位置を計算

  T_UF = T_AW + ((H_AW - H_UF) / 2)

  L_UF = L_AW + ((W_AW - W_UF) / 2)

  

  '**UFの表示位置を設定

  UFOb.StartUpPosition = Manual

  '**Top,Left指定時に必須(ないとLeftがずれる)

  UFOb.Top = T_UF

  UFOb.Left = L_UF

End Sub

Private Sub UserForm_Initialize()

    Call UFPositionCenter(Me)

End Sub


ThisWorkbookモジュールに書き込めばファイルを開くと同時にフォームが表示される。

Private Sub Workbook_open()

UserForm1.StartUpPosition = 1

UserForm1.Show

End Sub