2025年02月09日
VBAの備忘録
Sub 株式会社()
Dim hajime As Integer, saigo As Integer, i As Integer
hajime = Cells(Rows.Count, "A").End(xlUp).End(xlUp).Row + 1
saigo = Cells(Rows.Count, "A").End(xlUp).Row
Cells(hajime, 17).Select
For i = hajime To saigo
Cells(i, 17) = Replace(Cells(i, 17), "
", "(株)")
ActiveCell.Offset(1, 0).Select
Next i
Range("A2").Select
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub 有限会社()
Dim hajime As Integer, saigo As Integer, i As Integer
hajime = Cells(Rows.Count, "A").End(xlUp).End(xlUp).Row + 1
saigo = Cells(Rows.Count, "A").End(xlUp).Row
Cells(hajime, 17).Select
For i = hajime To saigo
Cells(i, 17) = Replace(Cells(i, 17), "
", "(有)")
ActiveCell.Offset(1, 0).Select
Next i
Range("A2").Select
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub 性別空白()
Dim hajime As Integer, saigo As Integer, i As Integer
' Application.ScreenUpdating = False '画面を更新させない
hajime = Cells(Rows.Count, "C").End(xlUp).End(xlUp).Row
saigo = Cells(Rows.Count, "C").End(xlUp).Row
Cells(hajime, 8).Select
For i = hajime To saigo
If ActiveCell.Value = "" Then
ActiveCell.Value = "法人"
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next i
Range("A2").Select
' Application.ScreenUpdating = True
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub 生年月日空白()
Dim hajime As Integer, saigo As Integer, i As Integer
' Application.ScreenUpdating = False '画面を更新させない
hajime = Cells(Rows.Count, "C").End(xlUp).End(xlUp).Row
saigo = Cells(Rows.Count, "C").End(xlUp).Row
Cells(hajime, 9).Select
For i = hajime To saigo
If ActiveCell.Value = "" Then
ActiveCell.Value = "-"
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next i
Range("A2").Select
' Application.ScreenUpdating = True
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・If VarType(ActiveCell.Value) = vbString Then ’アクティブセルが文字列
If IsNumeric(ActiveCell.Value) = True Then ’アクティブセルが数値
If IsNumeric(ActiveCell.Value) = False Then ’アクティブセルが数値以外
If Trim(ActiveCell.Value) = "" Then ’アクティブセルのスペースを空文字にして
If ActiveCell.Value = "" Then ’アクティブセルが空白
Cells(Rows.Count, 1).End(xlUp).End(xlUp).Select
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add2 Key:=Range("D:D"), Order:=xlAscending ''昇順
.SetRange ActiveCell.CurrentRegion
.Header = xlYes
.Apply
End With
ad = ActiveCell.Address(False, False) ’アドレス相対参照
Cells(Rows.Count, "C").End(xlUp).Select
Range(ad).AutoFilter 6, ""
Application.ScreenUpdating = False '画面を更新させない
Selection.NumberFormatLocal = "@" '書式を文字列に
Selection.NumberFormatLocal = "G/標準"
Selection.NumberFormatLocal = "yyyy/m/d"
Selection.NumberFormatLocal = "#,##0_ "
Application.DisplayAlerts = False 'メッセージを非表示
Application.DisplayAlerts = True 'メッセージを再表示
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub カンマ区切り()
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, Comma:=True
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub 受渡金額修正()
Dim i As Long
Cells(Rows.Count, "X").End(xlUp).End(xlUp).Select
For i = ActiveCell.Row To Cells(Rows.Count, "X").End(xlUp).Row
If Trim(ActiveCell.Value) = "" Then
' If VarType(ActiveCell.Value) = vbString Then
' ActiveCell.Value = " " Then
' 半角空白が17個を文字列としてVarType vbStringと記述している
ActiveCell.Value = 0
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub kyeskyes()
Dim i As Integer
For i = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
If Cells(i, "B") <> "" Then
Application.SendKeys "{F2}"
Application.SendKeys "{ENTER}"
End If
Next i
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Dim hajime As Integer, saigo As Integer, i As Integer
hajime = Cells(Rows.Count, "A").End(xlUp).End(xlUp).Row + 1
saigo = Cells(Rows.Count, "A").End(xlUp).Row
Cells(hajime, 17).Select
For i = hajime To saigo
Cells(i, 17) = Replace(Cells(i, 17), "

ActiveCell.Offset(1, 0).Select
Next i
Range("A2").Select
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub 有限会社()
Dim hajime As Integer, saigo As Integer, i As Integer
hajime = Cells(Rows.Count, "A").End(xlUp).End(xlUp).Row + 1
saigo = Cells(Rows.Count, "A").End(xlUp).Row
Cells(hajime, 17).Select
For i = hajime To saigo
Cells(i, 17) = Replace(Cells(i, 17), "

ActiveCell.Offset(1, 0).Select
Next i
Range("A2").Select
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub 性別空白()
Dim hajime As Integer, saigo As Integer, i As Integer
' Application.ScreenUpdating = False '画面を更新させない
hajime = Cells(Rows.Count, "C").End(xlUp).End(xlUp).Row
saigo = Cells(Rows.Count, "C").End(xlUp).Row
Cells(hajime, 8).Select
For i = hajime To saigo
If ActiveCell.Value = "" Then
ActiveCell.Value = "法人"
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next i
Range("A2").Select
' Application.ScreenUpdating = True
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub 生年月日空白()
Dim hajime As Integer, saigo As Integer, i As Integer
' Application.ScreenUpdating = False '画面を更新させない
hajime = Cells(Rows.Count, "C").End(xlUp).End(xlUp).Row
saigo = Cells(Rows.Count, "C").End(xlUp).Row
Cells(hajime, 9).Select
For i = hajime To saigo
If ActiveCell.Value = "" Then
ActiveCell.Value = "-"
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next i
Range("A2").Select
' Application.ScreenUpdating = True
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・If VarType(ActiveCell.Value) = vbString Then ’アクティブセルが文字列
If IsNumeric(ActiveCell.Value) = True Then ’アクティブセルが数値
If IsNumeric(ActiveCell.Value) = False Then ’アクティブセルが数値以外
If Trim(ActiveCell.Value) = "" Then ’アクティブセルのスペースを空文字にして
If ActiveCell.Value = "" Then ’アクティブセルが空白
Cells(Rows.Count, 1).End(xlUp).End(xlUp).Select
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add2 Key:=Range("D:D"), Order:=xlAscending ''昇順
.SetRange ActiveCell.CurrentRegion
.Header = xlYes
.Apply
End With
ad = ActiveCell.Address(False, False) ’アドレス相対参照
Cells(Rows.Count, "C").End(xlUp).Select
Range(ad).AutoFilter 6, ""
Application.ScreenUpdating = False '画面を更新させない
Selection.NumberFormatLocal = "@" '書式を文字列に
Selection.NumberFormatLocal = "G/標準"
Selection.NumberFormatLocal = "yyyy/m/d"
Selection.NumberFormatLocal = "#,##0_ "
Application.DisplayAlerts = False 'メッセージを非表示
Application.DisplayAlerts = True 'メッセージを再表示
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub カンマ区切り()
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, Comma:=True
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub 受渡金額修正()
Dim i As Long
Cells(Rows.Count, "X").End(xlUp).End(xlUp).Select
For i = ActiveCell.Row To Cells(Rows.Count, "X").End(xlUp).Row
If Trim(ActiveCell.Value) = "" Then
' If VarType(ActiveCell.Value) = vbString Then
' ActiveCell.Value = " " Then
' 半角空白が17個を文字列としてVarType vbStringと記述している
ActiveCell.Value = 0
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・Sub kyeskyes()
Dim i As Integer
For i = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
If Cells(i, "B") <> "" Then
Application.SendKeys "{F2}"
Application.SendKeys "{ENTER}"
End If
Next i
End Sub
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・
【(カテゴリなし)の最新記事】
投稿者:しろくまもーふ|20:47
この記事へのコメント