简单：使用VBAmacros将Web上的Booklistsorting到Excel中？

这是一个网站，其中有一个相对简单的书籍清单。

http://www.autism-resources.com/autism.bib我把这个列表复制到excel中，每一组％的符号都是一本书的列表，不同的细节如关键字等。 例如％T =标题。 我想要创build一个macros来search列表，并将每一行以“％whatever marker i choose”开头的行复制到B列

这里是我发现的代码，并且改变为与我想要的非常接近，除非我一直收到错误。

Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer Dim celltxt As String On Error GoTo Err_Execute LSearchRow = 1 LCopyToRow = 1 While Len(Range("A" & CStr(LSearchRow)).Value) > 0 celltxt = ActiveSheet.Range("A" & CStr(LSearchRow)).Value If InStr(1, celltxt, "%T") > 0 Then Cells("A" & CStr(LSearchRow)).Select Selection.Copy Cells("B" & CStr(LCopyToRow)).Select ActiveCell.Paste LCopyToRow = LCopyToRow + 1 End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A1").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub 

另外，我相信：

 While Len(range....) > 0 

设置为保持循环，直到活动单元格为空，但数据由每个书的空白行分隔。 我可以通过并删除空行，但有没有办法解决这个代码？

Answer 1

看看这是否适合你。 我使用Web查询并将数据下载到工作表“原始”

 'simple struct to describe each line of data Public Type InfoLine Tag As String Data As String End Type Sub Tester() Dim rw As Range, src As Range Dim dest As Range Dim line As String Dim numBlank As Integer Dim HadContent As Boolean Dim info As InfoLine Set src = ThisWorkbook.Worksheets("Raw").Range("A1") Set rw = ThisWorkbook.Worksheets("Books").Rows(1) Application.ScreenUpdating = False numBlank = 0 'stop after 10 consecutive blank cells Do While numBlank < 10 line = Trim(src.Value) If Len(line) > 0 Then numBlank = 0 info = GetInfoLine(line) If info.Tag <> "" Then Set dest = Nothing Select Case info.Tag Case "T": Set dest = rw.Cells(1) Case "B": Set dest = rw.Cells(2) Case "A": Set dest = rw.Cells(3) End Select If Not dest Is Nothing Then HadContent = True 'does the cell already have content? If Len(dest.Value) > 0 Then 'add new line after line break dest.Value = dest.Value & Chr(10) & info.Data Else dest.Value = info.Data End If End If Else 'no tag - continues previous line (if captured) If Not dest Is Nothing Then dest.Value = dest.Value & " " & line End If End If Else numBlank = numBlank + 1 If numBlank = 1 And HadContent Then Set rw = rw.Offset(1, 0) HadContent = False End If Set src = src.Offset(1, 0) Loop Application.ScreenUpdating = True End Sub Function GetInfoLine(line As String) As InfoLine Dim rv As InfoLine If line Like "%*" Then rv.Tag = UCase(Trim(Mid(line, 2, InStr(1, line, " ", 0) - 2))) rv.Data = Trim(Mid(line, InStr(line, " "))) Else rv.Tag = "" rv.Data = line End If GetInfoLine = rv End Function 

Answer 2

我想你会遇到麻烦，find可以为你写代码的人。

但是，如果你正在寻找一个出发点，我想说的第一件事就是使用webquery将数据导入到工作簿中。

Webquery一直回到Excel 97，但是这里是Excel 2010中的button，让你开始：

这将导入您的数据到工作表。

然后，这将是一个简单的循环，以确定该行是否以％开头，并相应地parsing文本，直到到达下一个以％开头的单元格。

循环可以在帮助文件中进行研究，有许多关于SO和networking的文章可以给你一些好的想法。

首先，写一些代码，然后张贴你写的东西，如果你仍然有问题。