指定した値がある行を別シートにコピーするChatGPT共作

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

このVBAプロシージャは、特定のキーワード（指定した値）に基づいて、アクティブなシートからそのキーワードを含む行を見つけ、見つかった行を別のシートにコピーするものです。以下で、詳しい流れをわかりやすく説明します。

---

1. 入力画面の表示:

   • プログラムを実行すると、「抽出する値をいれてください:」 というメッセージが表示されます。ここで、検索したいキーワード（値）を入力します。

2. アクティブシートの情報を取得:

   • キーワードを入力すると、現在アクティブなシートが対象となり、アクティブセルの列番号を取得します。プログラムはこの列を使って、特定のキーワードを探します。

   • さらに、アクティブシートの最終列と最終行も確認して、データの範囲を把握します。

3. データの読み込み:

   • シートのデータを一度、table という名前の変数に格納します。この方法でデータを扱うと、シートの操作が速くなります。

4. キーワードを含む行の検索:

   • データ全体をループして、入力したキーワードと一致するセルがあれば、その行をカウントしていきます。見つかった行の数を trueCount という変数に記録します。

5. 見つかったデータの保存:

   • 一致する行が見つかると、その数に応じて新しい配列（resultArray）を作成し、キーワードに一致する行のデータを保存します。

6. 新しいシートにコピー:

   • 最後に、新しいシートを作成し、そのシートにキーワードに一致する行を貼り付けます。この時、新しいシートには元のシートの見出し（1行目）もコピーされます。

   • 新しいシートの名前は、指定したキーワードが使われるため、わかりやすく管理できます。

7. スクリーン更新の再開:

   • プログラムが終了すると、再び画面の更新を有効に戻し、通常通り操作できるようになります。

このVBAプログラムの利点:

• たくさんのデータから特定の情報を簡単に抜き出すことができるので、データ整理の作業が効率的になります。

• 結果が自動で別シートにコピーされるので、作業の手間が減り、手作業のミスも防げます。

Sub 指定した値がある行を別シートにコピーするChatGPT共作()
    Application.ScreenUpdating = False
    Dim keyword As String
    keyword = InputBox("抽出する値をいれてください:", "値の指定")
    Dim ws                       As Worksheet
    Dim lastCol, lastRow, Col, i As Long
    
    ' アクティブシートを設定
    Set ws = ActiveSheet
    Col = ActiveCell.Column 'いまいる列
    
    ' アクティブシートのカラム数、レコード数を取得
    lastCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column
    lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row
    
    Dim table As Variant
    table = ws.Range("A2").Resize(lastRow - 1, lastCol).Value
    
    ' 条件に一致するレコード数をカウント
    Dim trueCount As Long
    trueCount = 0
    For i = LBound(table, 1) To UBound(table, 1)
        If keyword = table(i, Col) Then
            trueCount = trueCount + 1
        End If
    Next i
    
    ' 条件がTrueの分だけresultArrayを設定
    If trueCount > 0 Then
        Dim resultArray() As Variant
        ReDim resultArray(1 To trueCount, 1 To lastCol)
        
        Dim count As Long
        count = 0
        ' 条件に合うレコードをresultArrayに追加
        For i = LBound(table, 1) To UBound(table, 1)
            If keyword = table(i, Col) Then
                count = count + 1
                Dim j As Long
                For j = 1 To lastCol
                    resultArray(count, j) = table(i, j)
                Next j
            End If
        Next i
    End If

    ' 結果を別シートに出力
    Dim outputSheet As Worksheet
    Set outputSheet = Worksheets.Add
    outputSheet.Name = Replace(keyword, "/", "_")
    ws.Rows(1).Copy Destination:=outputSheet.Cells(1, 1)
    outputSheet.Range("A2").Resize(trueCount, lastCol).Value = resultArray
    
    Application.ScreenUpdating = True
End Sub

---

英語訳

Copy Rows with Specific Values to Another Sheet Collaboratively with ChatGPT

This explanation is created using ChatGPT.

This VBA procedure identifies rows on the active sheet that match a specified keyword and copies those rows to a new sheet. Here is how it works in detail:

---

1. Display Input Box:

   • When the program runs, it prompts with "Enter the value to extract:". You type the keyword (value) you want to search for.

2. Retrieve Active Sheet Information:

   • Once you enter the keyword, the program targets the currently active sheet, noting the column number of the active cell. It uses this column to search for the keyword.

   • It also determines the last column and row on the sheet to understand the range of data.

3. Load Data:

   • The data from the sheet is loaded into a variable called table. This approach speeds up data handling compared to interacting directly with the sheet.

4. Search for Matching Rows:

   • The program loops through the data, counting rows where the cell matches the entered keyword. The count is stored in a variable named trueCount.

5. Store Found Data:

   • If matching rows are found, a new array (resultArray) is created to store the data from those rows.

6. Copy to New Sheet:

   • A new sheet is created, and the matching rows are pasted onto it. Additionally, the header (first row) from the original sheet is copied to the new sheet.

   • The new sheet is named after the entered keyword, making it easy to identify.

7. Resume Screen Updates:

   • Once the program completes, screen updates are re-enabled, allowing you to proceed with regular tasks.

Benefits of This VBA Program:

• Easily extract specific information from large datasets, making data organization more efficient.

• Results are automatically copied to a new sheet, reducing manual work and preventing errors.

---

• Excel VBA リファレンス | Microsoft Learn

• Excelアイコンは、Icons8が作成したものです

• この記事のYouTube動画はこちら

ハッシュタグ

#excel #できること #vba #データ抽出 #セル検索 #シートコピー #業務効率化 #データ整理 #VBA入門 #シート自動作成 #プログラミング初心者 #Excel自動化 #入力ボックス #VBA応用 #アクティブシート #テーブル操作 #高速処理 #データマネジメント #配列操作 #シート追加