エクセル マクロ A列の <table> ～ </table>までを C列に抜き出したい

こんばんは表題通り、HTML内に書かれた　<table> ～　</table>までを　C列に抜きだすボタンクリックのコードを教えて頂けませんか？

よろしくお願いします。

質問者からの補足コメント

• 

  すみません　抜き出せていたみたいです。
  ありがとうございます！

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/04/02 02:28

• 

  ちなみに以下のコードなら抜き出すのですが、最初のコードが　</table>になっているばあい、</table>から<table>を選択してしまうのと、複数の抽出が出来ないです。
  
  一度に貼れないので、分割で掲載します。

    補足日時：2023/04/02 23:53

• Sub SelectRangeBetweenGoodAndNight()
  Dim firstCell As Range
  Dim lastCell As Range
  Dim goodCell As Range
  Dim nightCell As Range
  
  ' Find the first cell with "<table>" in column A
  Set goodCell = Range("A:A").Find("<table>", LookIn:=xlValues)
  
  ' Find the first cell with "</table>" in column A
  Set nightCell = Range("A:A").Find("</table>", LookIn:=xlValues)

    補足日時：2023/04/02 23:57

• ' Check if both cells are found
  If Not goodCell Is Nothing And Not nightCell Is Nothing Then
  ' Determine the first and last cells of the range to be selected
  If goodCell.Row < nightCell.Row Then
  Set firstCell = goodCell
  Set lastCell = nightCell
  Else
  Set firstCell = nightCell
  Set lastCell = goodCell

    補足日時：2023/04/02 23:58

• End If
  
  ' Select the range of cells between the first and last cells
  Range(firstCell, lastCell).Select
  Selection.Copy
  ActiveCell.Offset(0, 1).Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Else
  MsgBox "Could not find both '<table>' and '</table>' in column A.", vbExclamation
  End If
  End Sub

    補足日時：2023/04/02 23:58

No.5 ベストアンサー 回答者： Qchan1962 回答日時： 2023/04/03 16:14

A列だけなのでFindを使わず行う方が簡単かな・・

Sub Sample_01()
Const fKey As String = "<table>"
Const ukey As String = "</table>"
Dim c As Range
Dim fR As Range, lastCell As Range
Dim flag As Boolean
For Each c In ActiveSheet.Range("A1", Cells(Rows.Count, 1).End(xlUp))
Select Case c.Value
Case fKey
If flag = False Then
Set fR = c
flag = True
End If
Case ukey
If flag = True Then
Set lastCell = c
flag = False
End If
End Select
If Not fR Is Nothing And Not lastCell Is Nothing Then
Range(fR.Address, lastCell.Address).Copy Destination:=fR.Offset(, 2)
Set fR = Nothing
Set lastCell = Nothing
End If
Next
End Sub

出力はご質問の通り　C列　Offset(, 2)

下記のようなケースは想定外です
<table>
AA
<table>
AAA
</table>
BB
</table>

No.6 回答者： Qchan1962 回答日時： 2023/04/03 16:23

FindNextで行う場合　やり方は色々ありそうですが

一例で

Sub Sample_02()
Const fKey As String = "<table>"
Const ukey As String = "</table>"
Dim firstCell As Range, lastCell As Range
Dim fR As Range, uR As Range
Dim firstAddress As String, lastAddress As String
With ActiveSheet.Range("A1", ActiveSheet.Cells(Rows.Count, 1).End(xlUp))
Set fR = .Find(What:=fKey, LookIn:=xlValues, LookAt:=xlWhole)
If Not fR Is Nothing Then
firstAddress = fR.Address
Do
If Not firstCell Is Nothing Then
Set firstCell = Union(firstCell, fR)
Else
Set firstCell = fR
End If
Set fR = .FindNext(fR)
If fR Is Nothing Then Exit Do
Loop Until fR.Address = firstAddress
End If
Set uR = .Find(What:=ukey, After:=firstCell(1), LookIn:=xlValues, LookAt:=xlWhole)
If Not uR Is Nothing Then
lastAddress = uR.Address
Do
If Not lastCell Is Nothing Then
Set lastCell = Union(lastCell, uR)
Else
Set lastCell = uR
End If
Set uR = .FindNext(uR)
If uR Is Nothing Then Exit Do
Loop Until uR.Address = lastAddress
End If
'メイン処理
Dim rCount As Long, i As Long
rCount = Application.Min(firstCell.Areas.Count, lastCell.Areas.Count)
For i = 1 To rCount
Range(firstCell.Areas(i), lastCell.Areas(i)).Copy Destination:=firstCell.Areas(i).Offset(, 2)
Next
End With
End Sub

ちゃんと確認していないのでバグがあるかも知れません
悪しからず

この回答へのお礼

こんにちは、再回答頂きありがとうございます。

Qchanさんにはいつもお世話になっており、大変感謝ですm(_ _)m
今回もおかげさまでやりたいことが実現できました。

ありがとうございました！

お礼日時：2023/04/03 20:02

No.4 回答者： Qchan1962 回答日時： 2023/04/03 09:21

コードを拝見するにセル範囲を取得したいと言う事でしょうか・・

私が回答していたコードは1セル内に対象の文字列がある場合に　キーに挟まれた文字列を抽出するコードです

こんなケースはありますか　例　<table border="1">

＞</table>になっているばあい、</table>から<table>を選択してしまう
そのようになっていますが、
＞</table>になっているばあい　
1つ目の</table>を無視して　あくまで　<table> ～　</table>までで良いのでしょうか・・

取り合えず　補足コードの
＞最初のコードが　</table>になっているばあいの対処場所
（複数取得する必要が無ければ</table>を探す条件を加えて）

Set nightCell = Range("A:A").Find(What:="</table>", After:=goodCell, LookIn:=xlValues)

とすれば<table>以下の1番目の</table>が取得できると思います

If goodCell.Row < nightCell.Row Then　の　Else　側は不要かも知れませんね

複数処理を行う場合
FindNext メソッド　を使用すれば良いと思いますが
A列のみを対象にしているので　単純にループなどで繰り返し
<table>　が有ったら　フラグをたて　</table>でフラグを下すなどで
処理できるのではないでしょうか

この回答へのお礼

こんにちは、再回答いただきありがとうございます！

おっしゃる通り、開始タグが<table>でない場合は無視して、あくまでも<table>から</table>までを、存在する限り全て抜き出したいと言う事でした。

最初のブロックだけ（ひとつめの<table>～ひとつめの</table>まで）を抜き出す工程、こちらは教えて頂いた
Set nightCell = Range("A:A").Find(What:="</table>", After:=goodCell, LookIn:=xlValues)
で解消しました。

残るは複数抜き出す方法なんですが、すみません、私には理解不能なので、時間のある時にでも教えて頂けないでしょうか。

よろしくお願い致します！

お礼日時：2023/04/03 11:02

No.3 回答者： Qchan1962 回答日時： 2023/04/02 22:05

こんばんは

一応、文字列内に複数個ある場合　Function cutout_string　置き換え

Function cutout_string(target_string As String, fKey As String, ukey As String) As String
Dim tmp As String, ansTmp As String
Dim cnt As Long: cnt = 1
Dim n As Long: n = 1
On Error Resume Next
While cnt <= UBound(Split(target_string, fKey))
tmp = Mid(target_string, InStr(n, target_string, fKey) + Len(fKey))
ansTmp = ansTmp & Left(tmp, InStr(tmp, ukey) - 1) & vbCrLf
n = InStr(n, target_string, fKey) + 1
cnt = cnt + 1
Wend
cutout_string = Left(ansTmp, Len(ansTmp) - 1)
End Function

セル内改行を入れていますので改行コードに留意してください

この回答へのお礼

ありがとうございます。
すみません、やっぱり抜き出さないみたいです。

前回のやつも、今回のものも動作はしているのですがB列には何も出力しないみたいです。

お礼日時：2023/04/02 23:47

No.2 回答者： kantansi 回答日時： 2023/04/01 13:28

はい、以下のようなJavaScriptのコードで、HTML内に書かれた'<table～</table>をC列に抜き出すことができます。

javascript
Copy code
function extractTable() {
var table = document.getElementsByTagName('table')[0];
var rows = table.getElementsByTagName('tr');
var data = [];

for (var i = 0; i < rows.length; i++) {
var cols = rows[i].getElementsByTagName('td');
var rowData = [];

for (var j = 0; j < cols.length; j++) {
rowData.push(cols[j].innerText);
}

data.push(rowData);
}

var columnC = [];

for (var k = 0; k < data.length; k++) {
columnC.push(data[k][2]);
}

console.log(columnC); // C列のデータをコンソールに表示する

// もしGoogleスプレッドシートに出力する場合は以下のようにする
// var sheet = SpreadsheetApp.getActiveSheet();
// sheet.getRange(1, 3, columnC.length, 1).setValues(columnC);
}

このコードでは、最初にHTML内にある'タグを取得し、その中の各行と列を配列に格納します。その後、C列にあたる列のデータを別の配列に取り出し、コンソールに表示する部分のコメントアウトを解除すると、C列のデータが表示されます。Googleスプレッドシートに出力したい場合は、最後のコメントアウトを解除して、該当のコードを有効にしてください。

No.1 回答者： Qchan1962 回答日時： 2023/04/01 10:13

こんにちは

ご質問の内容だけでは・・お望みのカタチになるかどうか
1セルの文字列内に抜き差しシンボルが単数である場合の例

Sub ボタンクリック()
Const fKey As String = "<table>"
Const ukey As String = "</table>"
Dim r As Range
For Each r In Range("a1", Cells(Rows.Count, "A").End(xlUp))
r.Offset(, 2) = cutout_string(r.Value, fKey, ukey)
Next
End Sub

Function cutout_string(target_string As String, fKey As String, ukey As String) As String
Dim tmp As String
On Error Resume Next
tmp = Mid(target_string, InStr(target_string, fKey) + Len(fKey))
cutout_string = Left(tmp, InStr(tmp, ukey) - 1)
End Function

この回答へのお礼

こんにちは！
ありがとうございます。
全文をシート２のシートのコードの表示に入れて試してみました。

ボタンを押すと何か動作をしているようですが、C列には何も出ていない感じです。

お礼日時：2023/04/01 22:40