固定残業代の金額(カンマ付)だけ隣列にだすよ

この説明は、ChatGPTで作成しています。

このプロシージャは、選択されたセルの中から*「固定残業代」*に関連する金額（カンマ付き）を抽出し、その金額を隣の列に表示するものです。以下の手順で動作します。

1. 画面更新の停止:

   • `Application.ScreenUpdating = False`で、コードが実行される間の画面更新を停止し、処理速度を向上させます。

Application.ScreenUpdating = False

1. 正規表現オブジェクトの作成:

   • `CreateObject("VBScript.RegExp")`を使用して正規表現オブジェクトを作成します。このオブジェクトは、特定のパターンに一致するテキストを検索するために使います。

Set reg = CreateObject("VBScript.RegExp")

1. 正規表現パターンの設定:

   • `reg.Pattern = "(\d{1,3}(,\d{3})円)"`で、正規表現パターンを設定します。このパターンは、カンマ付きの金額（例：1,234円）を見つけるためのものです。

With reg
    .Pattern = "(\d{1,3}(,\d{3})円)"
    .IgnoreCase = True
    .Global = True
End With

1. 選択範囲内の各セルをループ:

   • `For Each myRng In Selection`で、選択された範囲内の各セルをループし、そのセルの値を取得します。

For Each myRng In Selection
    txt = myRng.Value

1. 一致するテキストの検索:

   • `reg.Execute(txt)`を使用して、セルの値からパターンに一致するテキストを検索します。マッチが見つかった場合は、そのマッチしたテキストを隣のセルに出力します。

Set match = reg.Execute(txt)
If match.Count > 0 Then
    myRng.Offset(0, 1).Value = match(0).Value
End If
Next myRng

1. 画面更新の再開:

   • 最後に、`Application.ScreenUpdating = True`で画面更新を再開します。

Application.ScreenUpdating = True

コードの具体的な説明

Sub 固定残業代の金額だけ隣列にだすよカンマあり()
    Application.ScreenUpdating = False
    
    Dim reg As Object
    Set reg = CreateObject("VBScript.RegExp") 'オブジェクト作成
    Dim myRng As Range
    Dim txt As String
    Dim match As Object
    Dim i As Long
    
    With reg
        .Pattern = "(\d{1,3}(,\d{3})円)"
        .IgnoreCase = True
        .Global = True
    End With
    
    On Error Resume Next
    For Each myRng In Selection
        txt = myRng.Value
        Set match = reg.Execute(txt)
        If match.Count > 0 Then
            myRng.Offset(0, 1).Value = match(0).Value ' マッチしたテキストを隣の列に出力
        End If
    Next myRng
    
    Application.ScreenUpdating = True
End Sub

このコードは、選択範囲内のセルから「1,234円」のような形式の固定残業代を見つけて、その金額を隣の列にコピーする機能を持っています。

---

Excel VBA　リファレンス | Microsoft Learn
この記事のYouTube動画はこちら

ハッシュタグ

#excel #できること #vba #固定残業代 #金額抽出 #カンマ付き金額 #正規表現 #セル操作 #隣の列に出力 #画面更新停止 #スクリーン更新 #VBAプログラミング #Excel自動化 #初心者向けVBA #VBAチュートリアル #オブジェクト作成 #パターンマッチング #マクロ #セルの値 #データ抽出

---

Fixed Overtime Amount to Adjacent Column with Comma

This explanation is created by ChatGPT.

This procedure extracts fixed overtime payment amounts (with commas) from the selected cells and displays those amounts in the adjacent column. Here is how it works:

1. Stop Screen Updating:

   • `Application.ScreenUpdating = False` stops screen updating while the code runs to improve processing speed.

Application.ScreenUpdating = False

1. Create Regular Expression Object:

   • `CreateObject("VBScript.RegExp")` creates a regular expression object used to search for specific patterns in text.

Set reg = CreateObject("VBScript.RegExp")

1. Set Regular Expression Pattern:

   • `reg.Pattern = "(\d{1,3}(,\d{3})円)"` sets the pattern to find amounts with commas (e.g., 1,234円).

With reg
    .Pattern = "(\d{1,3}(,\d{3})円)"
    .IgnoreCase = True
    .Global = True
End With

1. Loop Through Each Cell in Selection:

   • `For Each myRng In Selection` loops through each cell in the selected range, obtaining the cell's value.

For Each myRng In Selection
    txt = myRng.Value

1. Search for Matching Text:

   • `reg.Execute(txt)` searches the cell's value for text matching the pattern. If a match is found, the matching text is output to the adjacent cell.

Set match = reg.Execute(txt)
If match.Count > 0 Then
    myRng.Offset(0, 1).Value = match(0).Value
End If
Next myRng

1. Restart Screen Updating:

   • Finally, `Application.ScreenUpdating = True` restarts screen updating.

Application.ScreenUpdating = True

Detailed Code Explanation

Sub 固定残業代の金額だけ隣列にだすよカンマあり()
    Application.ScreenUpdating = False
    
    Dim reg As Object
    Set reg = CreateObject("VBScript.RegExp") ' Create object
    Dim myRng As Range
    Dim txt As String
    Dim match As Object
    Dim i As Long
    
    With reg
        .Pattern = "(\d{1,3}(,\d{3})円)"
        .IgnoreCase = True
        .Global = True
    End With
    
    On Error Resume Next
    For Each myRng In Selection
        txt = myRng.Value
        Set match = reg.Execute(txt)
        If match.Count > 0 Then
            myRng.Offset(0, 1).Value = match(0).Value ' Output matched text to adjacent column
        End If
    Next myRng
    
    Application.ScreenUpdating = True
End Sub

This code finds fixed overtime amounts like "1,234円" within the selected range and copies those amounts to the adjacent column.

---

Excel VBA Reference | Microsoft Learn
YouTube video of this article

Hashtags

#excel #whatyoucando #vba #fixedovertime #amountextraction #amountwithcommas #regex #celloperation #outputtoadjacentcolumn #stopscreenupdating #screenupdating #VBAprogramming #Excelautomation #VBAbeginners #VBAtutorial #createobject #patternmatching #macro #cellvalue #dataextraction

---

文字数: 1001