html形式のファイルをワークシートに読み込みます。

1行を読み込んで、"<" ">" で区切ってセルに入れていきます。

たとえば、


<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
<head>
<title>Excel macro</title>
</head>

<body>
<h1>Excel 自作マクロ集</h1>
<p><a href="text_open.html">1. *.txt ファイルをワークシートに読み込む</a>
<p><a href="html_read.html">2. *.html ファイルをワークシートに読み込む</a>
<p><a href="chart1.html">3. 散布図のラベルを書き換える</a>
<p><a href="vlookup.html">4.同じ入力内容の行を探す</a>
<p><a href="test1.html">5.セルに数字が入力されている時だけそのセルを参照する式を別のセルに入れる</a>
<p><a href="color_chart.html">6.色見本(カラーチャート)を作る</a>
</body>
</html>

というファイルを読み込むと、以下のようになります。

A B C D
1 <!doctype html public "-//w3c//dtd html 4.0 transitional//en">      
2 <html>      
3 <head>      
4 <title> Excel macro </title>  
5 </head>      
6        
7 <body>      
8 <h1> Excel 自作マクロ集 </h1>  
9 <p> <a href="text_open.html"> 1. *.txt ファイルをワークシートに読み込む </a>
10 <p> <a href="html_read.html"> 2. *.html ファイルをワークシートに読み込む </a>
11 <p> <a href="chart1.html"> 3. 散布図のラベルを書き換える </a>
12 <p> <a href="vlookup.html"> 4.同じ入力内容の行を探す </a>
13 <p> <a href="test1.html"> 5.セルに数字が入力されている時だけそのセルを参照する式を別のセルに入れる </a>
14 <p> <a href="color_chart.html"> 6.色見本(カラーチャート)を作る </a>
15 </body>      
16 </html>      


目次系のファイルの編集にはそれなりに便利なのではないかと・・・。


Sub html_read()
    Dim file_name As String
    Dim x As String
    Dim x1 As String
    Dim xn As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    
    file_name = Application.GetOpenFilename
    
    Open file_name For Input As #1
    
    j = 1
    While Not EOF(1)
        Line Input #1, x
        xn = Len(x)
        k = 2
        
        For i = 1 To xn
            a = Mid(x, i, 1)
            Select Case a
                Case "<"
                    If x1 <> "" Then
                        Cells(j, k) = x1
                        k = k + 1
                        x1 = "<"
                    Else
                        x1 = "<"
                    End If
                Case ">"
                    x1 = x1 + ">"
                    Cells(j, k) = x1
                    k = k + 1
                    x1 = ""
                Case Else
                    If i < xn Then
                        x1 = x1 + a
                    Else
                        Cells(j, k) = x1 + a
                        k = k + 1
                        x1 = ""
                    End If
            End Select
        Next i
        j = j + 1
    Wend
    
    Close #1
End Sub

back