アーカイブ

‘未分類’ カテゴリーのアーカイブ

HTMLのテーブルタグを縦横入れ替える

2010 年 4 月 22 日 コメントはありません
某大手ECサイトというか楽天の一括更新はCSVなので必然的にExcelでやる羽目になる。
商品情報をなぜかテーブルタグで書いてたのでそれを縦横入れ替えたいときは下記のようなスクリプトを書けば一括ですね、という話。
Option Explicit
Sub main()
Dim SelectCell As Range
Set SelectCell = Range(“g3″)
SelectCell.Activate
While SelectCell.Value <> “”
If InStr(SelectCell.Value, “table”) <> 0 Then
SelectCell.Value = ReplaceHTML(SelectCell.Value)
End If
Set SelectCell = SelectCell.Cells(2, 1)
SelectCell.Activate
Wend
End Sub
Function ReplaceHTML(str As String) As String
Dim pos_header As Integer
Dim pos_footer As Integer
Dim pos_tbl_header As Integer
Dim pos_tbl_footer As Integer
Dim header As String
Dim footer As String
Dim table_data As String
Dim table_body As String
Dim table_header As String
Dim table_footer As String
Dim table_body_th As String
Dim table_body_td As String
Dim temp As String
Dim title As Variant
Dim data As Variant
Dim i As Integer
‘テーブルタグまでヘッダを検出する
pos_header = InStr(str, “<table”)
header = Left(str, pos_header – 1)
‘テーブルタグが終わった後のフッタを検出する
pos_footer = InStr(str, “</table>”)
footer = Right(str, Len(str) – pos_footer – 7)
table_data = Mid(str, pos_header, Len(str) – (Len(str) – pos_footer) – pos_header + 8)
‘Debug.Print “header——” & header
‘Debug.Print “table——-” & table_data
‘Debug.Print “footer——” & footer
pos_tbl_header = InStr(table_data, “<tr”)
table_header = Left(table_data, pos_tbl_header – 1)
pos_tbl_footer = InStr(table_data, “</table>”)
table_footer = Right(table_data, Len(table_data) – pos_tbl_footer)
‘テーブルのTR的な部分だけを検出。
table_body = Mid(table_data, pos_tbl_header, Len(table_data) – pos_tbl_header – (Len(table_data) – pos_tbl_footer – 1))
‘Debug.Print “テーブルのヘッダ部分” & table_header
‘Debug.Print “テーブルのフッタ部分” & table_footer
‘Debug.Print “テーブルの本体部分” & table_body
‘<TH>部分を抜き出す
table_body_th = Left(table_body, InStr(table_body, “</tr>”) + 4)
table_body_td = Right(table_body, Len(table_body) – Len(table_body_th))
‘Debug.Print “Th部分” & table_body_th
‘Debug.Print “Td部分” & table_body_td
title = Split(table_body_th, “</th>”)
data = Split(table_body_td, “</td>”)
For i = 0 To UBound(title)
title(i) = RemoveHTML(title(i))
Next i
For i = 0 To UBound(data)
data(i) = RemoveHTML(data(i))
Next i
For i = 0 To UBound(title) – 1
temp = temp & “<tr>”
temp = temp & “<th>” & title(i) & “</th>”
temp = temp & “<td>” & data(i) & “</td>”
temp = temp & “</tr>”
Next
ReplaceHTML = header & table_header & temp & “</table>” & footer
End Function
Function RemoveHTML(strHTML) As String
‘HTMLタグを削除するファンクション
Dim Flg As Boolean
Dim i As Integer
For i = 1 To Len(strHTML)
If Mid(strHTML, i, 1) = “<” Then
Flg = True
Mid(strHTML, i, 1) = ” “
ElseIf Mid(strHTML, i, 1) = “>” Then
Flg = False
Mid(strHTML, i, 1) = ” “
ElseIf Flg Then
Mid(strHTML, i, 1) = ” “
End If
Next
strHTML = Replace(strHTML, ” “, “”)
‘Debug.Print strHTML
RemoveHTML = strHTML
End Function

Option Explicit
Sub main()Dim SelectCell As Range
Set SelectCell = Range(“g3″)SelectCell.Activate
While SelectCell.Value <> “”    If InStr(SelectCell.Value, “table”) <> 0 Then        SelectCell.Value = ReplaceHTML(SelectCell.Value)    End If    Set SelectCell = SelectCell.Cells(2, 1)    SelectCell.ActivateWend
End Sub
Function ReplaceHTML(str As String) As String
Dim pos_header As IntegerDim pos_footer As IntegerDim pos_tbl_header As IntegerDim pos_tbl_footer As Integer
Dim header As StringDim footer As StringDim table_data As StringDim table_body As StringDim table_header As StringDim table_footer As StringDim table_body_th As StringDim table_body_td As StringDim temp As String
Dim title As VariantDim data As Variant
Dim i As Integer
‘テーブルタグまでヘッダを検出するpos_header = InStr(str, “<table”)header = Left(str, pos_header – 1)
‘テーブルタグが終わった後のフッタを検出するpos_footer = InStr(str, “</table>”)footer = Right(str, Len(str) – pos_footer – 7)
table_data = Mid(str, pos_header, Len(str) – (Len(str) – pos_footer) – pos_header + 8)
‘Debug.Print “header——” & header’Debug.Print “table——-” & table_data’Debug.Print “footer——” & footer
pos_tbl_header = InStr(table_data, “<tr”)table_header = Left(table_data, pos_tbl_header – 1)
pos_tbl_footer = InStr(table_data, “</table>”)table_footer = Right(table_data, Len(table_data) – pos_tbl_footer)

‘テーブルのTR的な部分だけを検出。table_body = Mid(table_data, pos_tbl_header, Len(table_data) – pos_tbl_header – (Len(table_data) – pos_tbl_footer – 1))
‘Debug.Print “テーブルのヘッダ部分” & table_header’Debug.Print “テーブルのフッタ部分” & table_footer’Debug.Print “テーブルの本体部分” & table_body
‘<TH>部分を抜き出す
table_body_th = Left(table_body, InStr(table_body, “</tr>”) + 4)table_body_td = Right(table_body, Len(table_body) – Len(table_body_th))
‘Debug.Print “Th部分” & table_body_th’Debug.Print “Td部分” & table_body_td
title = Split(table_body_th, “</th>”)data = Split(table_body_td, “</td>”)
For i = 0 To UBound(title)    title(i) = RemoveHTML(title(i))Next i
For i = 0 To UBound(data)    data(i) = RemoveHTML(data(i))Next i
For i = 0 To UBound(title) – 1    temp = temp & “<tr>”    temp = temp & “<th>” & title(i) & “</th>”    temp = temp & “<td>” & data(i) & “</td>”    temp = temp & “</tr>”Next
ReplaceHTML = header & table_header & temp & “</table>” & footer
End Function
Function RemoveHTML(strHTML) As String’HTMLタグを削除するファンクション
Dim Flg As Boolean
Dim i As Integer
For i = 1 To Len(strHTML)    If Mid(strHTML, i, 1) = “<” Then        Flg = True        Mid(strHTML, i, 1) = ” “    ElseIf Mid(strHTML, i, 1) = “>” Then        Flg = False        Mid(strHTML, i, 1) = ” “    ElseIf Flg Then        Mid(strHTML, i, 1) = ” “    End If Next strHTML = Replace(strHTML, ” “, “”)’Debug.Print strHTMLRemoveHTML = strHTMLEnd Function

カテゴリー: 未分類 タグ:

久々に

2010 年 4 月 2 日 コメント 1 件

VBA書いたので残しておくw
Set ~思い出すのに3分かかったw

Sub main()
Dim SelectCell As Range

Set SelectCell = Range(“i2″)
SelectCell.Activate

While SelectCell.Value <> “”

SelectCell.Value = ReplaceHTML(SelectCell.Value)

Set SelectCell = SelectCell.Cells(2, 1)
SelectCell.Activate

Wend

End Sub

Function ReplaceHTML(str As String) As String

Dim pos As Integer
Dim str1 As String
Dim str2 As String

‘最初のTRまで検出する
pos = InStr(str, “</tr”)

str1 = Left(str, pos)
str2 = Right(str, Len(str) – pos)

str1 = Replace(str1, “<tr”, “<tr id=”"st_head”" “, 1, -1, vbTextCompare)
str2 = Replace(str2, “<tr”, “<tr id=”"st_date”" “, 1, -1, vbTextCompare)

ReplaceHTML = str1 & str2

End Function

カテゴリー: 未分類 タグ:

【Z3】事故った

2010 年 3 月 26 日 コメントはありません

はい、事故りました(2週間も前だけど)

これからこのブログはZ3の修復日記になります(何故か前にもこんなことがあった気がするのは気のせい)

カテゴリー: 未分類 タグ:

ロードバイクのヘルメット

2010 年 2 月 7 日 コメントはありません

ロードバイク暦2日目。

やはり必要だということで購入。
Amazonで発注してしまった…

んで、フロントディレイラーがアウター側のときにリアがインにいくと音がする件が気になって調整してみたものの、先人にいわせると「仕様です」とのこと。
なんじゃそらー

明日は早起きできれば初通勤!

カテゴリー: 未分類 タグ:

ロードバイク購入

2010 年 2 月 6 日 コメントはありません

本日届きました。

目指せ通勤快速!です。

いっぱい走るぞ~

カテゴリー: 未分類 タグ:

【読了】邪悪なものの鎮め方

2010 年 2 月 3 日 コメントはありません

ほとんどブログで読める内容ですが、ものを読むには紙媒体のほうがいいです。
どう良いかというと、説明するのは難しいですが、発光してる物体の上に描かれているドットの集合体と紙に印刷されているものでは、入ってくるときに通るところが違う気がする。
わかりにくいはなしですまない。

先生も書いてるけど次々と読み進めてしまうので、あっという間に読んでしまうがまた読み返したくなる。

ナチューレ文庫に追加しました。

カテゴリー: 未分類 タグ:

BMW Z3メンテ記録 ウィンドリフレクタの取り外し

2010 年 1 月 11 日 コメントはありません

うちの子はアニバーサリーモデル(多分一番最初の数百台?限定車)なのですが。
この子のメンテ公開してるページが皆無なのです。

とりあえず、今日苦労したことはウィンドリフレクタの外し方。

そもそも、他のページでみるウィンドリフレクタとは微妙に取り付け方が違うんです。なんか鍵のようなパーツが部分があってそこをまわせば外せそう。というか結論としては専用の鍵で開けるようです。でもそんな鍵ついてこなかった…。これって社外品なのかしら?

おかげでだいぶ苦労してウィンドリフレクタの取り外しをした後、したかったことは。リアスクリーンのメンテ。

プレクサスがいいらしいということで、プレクサスを吹いてしばらく待ち、ふき取ると不思議なことにあんなに曇っていたリアスクリーン(プラスチック製)の透明度がかなり向上しました。

恐るべしプレクサス、ちなみにオートバックスで定価で買いましたがドンキホーテではかなり安いらしいです…。

カテゴリー: Z3, 未分類 タグ:

復活

2010 年 1 月 5 日 コメントはありません

なぜかアクセスできなくなっていたブログ。
原因はデータベースが物故割れてただけでした。

なんでかなー。

カテゴリー: 未分類 タグ:

Hello world!

2010 年 1 月 5 日 コメントはありません

WordPress へようこそ。これは最初の投稿です。編集もしくは削除してブログを始めてください !

カテゴリー: 未分類 タグ: