如何把每题各选项的所对应的代码提取出来放入E——J列？

NewZealand · 发表于 2016-10-16 22:21

本帖最后由 NewZealand 于 2016-10-16 22:28 编辑

想把网页源码中的题号id和各选项的id提取出来，用来自动填写答案
自动选中填答案的代码：.document.getElementById(t).Click

问题：如何把每题各选项的所对应的代码提取出来放入E——J列？

<input type="hidden" name="answer23616337" id="answer23616337" value="" /><label for="a"><input type="checkbox" name="answerinput23616337" id="24011434" value="24011434"/><b>A</b></label>

ID	题号	答案	答案代码	A	B	C	D	E	F
23615251	1	B	23615253	23615252	23615253	23615254	23615255
25380431	2	A	25380434	25380432	25380433	25380434	25380435
24850992	3	A	24850994	24850993	24850994
	……
	……
	……
23616337	47	ABCD	24011434、24011435、24011436、24011437	24011434	24011435	24011436	24011437
23619068	48	ABC	23619069、23619070、23619071	23619069	23619070	23619071	23619072
	49	ABD
23618554	50	ABCD	23960487、23960488、23960489、23960490	23960487	23960488	23960489	23960490

test01.rar (23.4 KB, 下载次数: 12)

crazy0qwer · 发表于 2016-10-17 00:29

本帖最后由 crazy0qwer 于 2016-10-17 00:30 编辑

固定文件名，工作簿目录下。

Sub Crazy0qwer()
Dim Ad As Object
Dim Ar(1 To 1000, 1 To 2), Br(1 To 1000, 1 To 6)
Dim P As String, F As String, Str As String
Dim N As Long, X As Long, Y As Long, I As Long
P = ThisWorkbook.Path & ""
F = "onlineAnswerSjfs.do gqid=27623479.htm"
Set Ad = CreateObject("adodb.stream")
With Ad
.Charset = "utf-8"
.Type = 2
.Open
.LoadFromFile P & F
Str = .ReadText
.Close
End With
Set Ad = Nothing
X = 1
Do
X = InStr(X, Str, "name=""tkid""")
If X = 0 Then Exit Do
N = N + 1
Y = InStr(X + 19, Str, """")
Ar(N, 1) = Mid$(Str, X + 19, Y - X - 19)
X = InStr(X, Str, "第 ")
Ar(N, 2) = Val(Mid$(Str, X + 7, 3))
For I = 1 To 6
Y = InStr(X, Str, "type=""")
If Y = 0 Or Y > InStr(X, Str, "</div>") Then Exit For
X = InStr(Y, Str, "id=")
Y = InStr(X + 4, Str, """")
Br(N, I) = Mid$(Str, X + 4, Y - X - 4)
Next
Loop
Rows("2:1000").ClearContents
[A2].Resize(N, 2) = Ar
[E2].Resize(N, 6) = Br
End Sub

复制代码

NewZealand · 发表于 2016-10-17 07:57

大侠的代码精简，谢谢啦，值得学习。谢谢

NewZealand · 发表于 2016-10-19 19:50

我自己写了代码，用了dic、split等方法，能把题目和选项提取出来，但特别繁琐，能否再帮忙看看。
题目保存在题目代码列，答案A—F分别保存在对应的标题列。

ID 题号答案题目 A B C D E
23615251 1 第 1 道题、单选题：造成不良影响，情节较重的，给予____处分。 A.警告或者严重警告 B.严重警告或者撤销党内职务 C.撤销党内职务或者留党察看 D.留党察看或者开除党籍
…… …… ……

crazy0qwer · 发表于 2016-10-19 23:22

本帖最后由 crazy0qwer 于 2016-10-19 23:52 编辑

NewZealand 发表于 2016-10-19 19:50
我自己写了代码，用了dic、split等方法，能把题目和选项提取出来，但特别繁琐，能否再帮忙看看。
题目保存 ...

下面这段和上面一段代码，对文件格式要求较高，故结果不保证百分百。

Sub Crazy0qwer1()
Dim Ad As Object
Dim Ar(1 To 1000, 1 To 2), Br(1 To 1000, 1 To 7)
Dim P As String, F As String, Str As String
Dim N As Long, X As Long, Y As Long, I As Long
P = ThisWorkbook.Path & ""
F = "onlineAnswerSjfs.do gqid=27623479.htm"
Set Ad = CreateObject("adodb.stream")
With Ad
.Charset = "utf-8"
.Type = 2
.Open
.LoadFromFile P & F
Str = .ReadText
.Close
End With
Set Ad = Nothing
X = 1
Do
X = InStr(X, Str, "name=""tkid""")
If X = 0 Then Exit Do
N = N + 1
Ar(N, 1) = Mid$(Str, X + 19, InStr(X + 19, Str, """") - X - 19)
X = InStr(X, Str, "第")
Ar(N, 2) = Val(Mid$(Str, X + 7, 3))
X = InStr(X, Str, "：")
Br(N, 1) = Mid$(Str, X + 1, InStr(X, Str, "</p>") - X - 1)
Y = X
For I = 2 To 7
Y = InStr(Y + 10, Str, "<p style=")
If Y = 0 Or Y > InStr(X, Str, "</div>") Then Exit For
Y = InStr(Y + 10, Str, "</span>")
X = InStrRev(Str, ">", Y - 2)
Br(N, I) = Mid$(Str, X + 1, Y - X - 1)
Next
Loop
Rows("2:1000").ClearContents
[A2].Resize(N, 2) = Ar
[D2].Resize(N, 7) = Br
End Sub

复制代码

NewZealand · 发表于 2016-10-20 19:26

crazy0qwer 发表于 2016-10-19 23:22
下面这段和上面一段代码，对文件格式要求较高，故结果不保证百分百。

网抓高手！佩服

用自己熟悉的方法提取文本然后再分割也实现了

      For Each inputs In .document.getElementsbyTagName("p") '.Document.all.Tag("input")
         Mytexts = Mytexts & inputs.innertext
      Next
      Mytext = Split(Mytexts, "道题、")

		自动登录	找回密码
密码			免费注册

[求助] 如何把每题各选项的所对应的代码提取出来放入E——J列？

评分

最新热点 /1