改良版_横長の表から指定したキーワードを含む情報を項目名と一緒にHTML表示する

2024年6月29日 16:00

この説明は、ChatGPTで作成しています。
※改良部分：HTMLに表示する際に、セル内改行も反映するようにしました

このプロシージャは、Excelのシートから指定したキーワードを含む情報をHTML形式で表示するものです。以下に仕組みをわかりやすく説明します。

キーワードの入力:
- InputBoxを使用して、検索するキーワードを入力します。
- キーワードが入力されなかった場合、メッセージを表示して終了します。
シートと選択範囲の確認:
- ThisWorkbook.ActiveSheetで現在アクティブなシートを設定します。
- Application.Selectionで選択範囲を取得します。
- 選択範囲が1行でない場合、メッセージを表示して終了します。
列名と選択した行のデータ取得:
- 1行目の列名と選択した行のデータをそれぞれ取得します。
キーワードの検索:
- キーワードが含まれるセルを探し、そのセルの値をHTMLの<br>タグを使用して改行に変換し、キーワードを赤色にします。
- 見つかった列名とデータを別の変数に格納します。
HTMLの作成:
- 見つかった列名とデータをHTML形式に整え、一時ファイルに書き込みます。
Microsoft Edgeで表示:
- 作成したHTMLファイルをMicrosoft Edgeで開きます。

このプロシージャは、以下のような構造になっています。

Sub 改良版_横長の表から指定したキーワードを含む情報を項目名と一緒にHTML表示する()
    ' 検索するキーワードを入力
    Dim keyword As String
    keyword = InputBox("検索するキーワードを入力してください:", "キーワード入力")
   
    ' キーワードが空白の場合のメッセージを表示
    If keyword = "" Then
        MsgBox "有効なキーワードを入力してください。", vbExclamation
        Exit Sub
    End If
   
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    Dim rng As Range
    Set rng = Application.Selection
    ' 列名の行を選択した場合のメッセージを表示して終了
    If rng.Rows.Count <> 1 Then
        MsgBox "単一のレコードを選択してください。", vbExclamation
        Exit Sub
    End If
   
    Dim headers As Variant
    headers = ws.Rows(1).Value ' すべての列名を取得
   
    Dim recordRow As Variant
    recordRow = ws.Rows(rng.Row).Value ' 選択したレコードのすべての値を取得
   
    Dim found As Boolean
    found = False
    Dim foundHeaders As Collection
    Set foundHeaders = New Collection
    Dim foundRecords As Collection
    Set foundRecords = New Collection
   
    Dim i As Integer
    For i = LBound(recordRow, 2) To UBound(recordRow, 2)
        ' エラー表示を代替テキストに置き換え
        Dim cellValue As String
        If IsError(recordRow(1, i)) Then
            cellValue = "　●エラー●　"
        Else
            cellValue = recordRow(1, i)
        End If
        ' 改行をHTMLの<br>タグに変換
        cellValue = Replace(cellValue, vbLf, "<br>")
        ' キーワードを含む列名とレコードを別の変数に格納し、キーワードを赤色にするコードを追加
        If InStr(cellValue, keyword) > 0 Then
            found = True
            foundHeaders.Add headers(1, i)
            foundRecords.Add Replace(cellValue, keyword, "<span style='color:red;'>" & keyword & "</span>")
        End If
    Next i
    ' キーワードが見つからなかった場合のメッセージを表示して終了
    If Not found Then
        MsgBox "選択したレコードにはキーワード """ & keyword & """ が含まれていません。", vbExclamation
        Exit Sub
    End If
   
    ' 列名とレコードを表示するHTMLを準備
    Dim htmlOutput As String
    htmlOutput = "<html><body>"
   
    For i = 1 To foundHeaders.Count
        htmlOutput = htmlOutput & "<div><strong>" & foundHeaders(i) & "</strong></div>"
        htmlOutput = htmlOutput & "<div>" & foundRecords(i) & "</div><br>"
    Next i
   
    htmlOutput = htmlOutput & "</body></html>"
   
    ' HTMLを一時ファイルに書き込み
    Dim tempFilePath As String
    tempFilePath = Environ$("temp") & "\temp.html"
   
    Dim fileNum As Integer
    fileNum = FreeFile
    Open tempFilePath For Output As fileNum
    Print #fileNum , htmlOutput
    Close fileNum
   
    ' HTMLファイルをMicrosoft Edgeで開く
    Dim edgePath As String
    edgePath = """C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"""
   
    Dim shellCommand As String
    shellCommand = edgePath & " " & tempFilePath
    Shell shellCommand, vbNormalFocus
End Sub

このようにして、Excelシート内のデータを簡単にHTML形式で表示することができます。

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

Improved Version: Display Specified Keyword Information from a Horizontal Table with Column Names in HTML

This explanation is created using ChatGPT.
※Improved part: Reflected cell line breaks when displaying in HTML

This procedure displays information containing a specified keyword from an Excel sheet in HTML format. Here’s a step-by-step explanation of how it works:

Entering the Keyword:
- An InputBox prompts the user to enter a search keyword.
- If no keyword is entered, a message is displayed, and the procedure exits.
Checking the Sheet and Selected Range:
- ThisWorkbook.ActiveSheet sets the current active sheet.
- Application.Selection gets the selected range.
- If the selected range is not a single row, a message is displayed, and the procedure exits.
Getting Column Names and Selected Row Data:
- The column names from the first row and the data from the selected row are obtained.
Searching for the Keyword:
- Cells containing the keyword are found, their values are converted to HTML format with <br> tags for line breaks, and the keyword is highlighted in red.
- The found column names and data are stored in separate variables.
Creating HTML:
- The found column names and data are formatted into HTML and written to a temporary file.
Displaying in Microsoft Edge:
- The created HTML file is opened in Microsoft Edge.

The procedure is structured as follows:

Sub Improved_Display_Info_With_Specified_Keyword_From_Wide_Table_As_HTML()
    ' Enter the keyword to search
    Dim keyword As String
    keyword = InputBox("Please enter the keyword to search:", "Keyword Input")
   
    ' Display a message if the keyword is empty
    If keyword = "" Then
        MsgBox "Please enter a valid keyword.", vbExclamation
        Exit Sub
    End If
   
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
    Dim rng As Range
    Set rng = Application.Selection
    ' Display a message and exit if the header row is selected
    If rng.Rows.Count <> 1 Then
        MsgBox "Please select a single record.", vbExclamation
        Exit Sub
    End If
   
    Dim headers As Variant
    headers = ws.Rows(1).Value ' Get all column names
   
    Dim recordRow As Variant
    recordRow = ws.Rows(rng.Row).Value ' Get all values of the selected record
   
    Dim found As Boolean
    found = False
    Dim foundHeaders As Collection
    Set foundHeaders = New Collection
    Dim foundRecords As Collection
    Set foundRecords = New Collection
   
    Dim i As Integer
    For i = LBound(recordRow, 2) To UBound(recordRow, 2)
        ' Replace error display with alternative text
        Dim cellValue As String
        If IsError(recordRow(1, i)) Then
            cellValue = "　●Error●　"
        Else
            cellValue = recordRow(1, i)
        End If
        ' Convert line breaks to HTML <br> tags
        cellValue = Replace(cellValue, vbLf, "<br>")
        ' Store the column names and records containing the keyword in separate variables, and add code to highlight the keyword in red
        If InStr(cellValue, keyword) > 0 Then
            found = True
            foundHeaders.Add headers(1, i)
            foundRecords.Add Replace(cellValue, keyword, "<span style='color:red;'>" & keyword & "</span>")
        End If
    Next i
    ' Display a message and exit if the keyword is not found
    If Not found Then
        MsgBox "The selected record does not contain the keyword """ & keyword & """.", vbExclamation
        Exit Sub
    End If
   
    ' Prepare HTML to display column names and records
    Dim htmlOutput As String
    htmlOutput = "<html><body>"
   
    For i = 1 To foundHeaders.Count
        htmlOutput = htmlOutput & "<div><strong>" & foundHeaders(i) & "</strong></div>"
        htmlOutput = htmlOutput & "<div>" & foundRecords(i) & "</div><br>"
    Next i
   
    htmlOutput = htmlOutput & "</body></html>"
   
    ' Write HTML to a temporary file
    Dim tempFilePath As String
    tempFilePath = Environ$("temp") & "\temp.html"
   
    Dim fileNum As Integer
    fileNum = FreeFile
    Open tempFilePath For Output As fileNum
    Print #fileNum , htmlOutput
    Close fileNum
   
    ' Open the HTML file in Microsoft Edge
    Dim edgePath As String
    edgePath = """C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"""
   
    Dim shellCommand As String
    shellCommand = edgePath & " " & tempFilePath
    Shell shellCommand, vbNormalFocus
End Sub

In this way, you can easily display data from an Excel sheet in HTML format.

Excel VBA Reference | Microsoft Learn
Watch the YouTube video for this article here

#excel #できること #vba #html表示 #キーワード検索 #データ抽出 #Excel操作 #VBA初心者 #プログラミング解説 #エクセルマクロ #シート操作 #データ分析 #自動化 #Excel活用 #プログラム解説 #データ処理 #マクロ作成 #業務効率化 #VBAスクリプト #Excel関数

この記事が気に入ったらサポートをしてみませんか？