ПРОСТО: сортировать Booklist на Web в Excel, используя макрос VBA?

Question

Вот сайт со списком книг в относительно простом формате.

http://www.autism -resources.com / autism.bib Я скопировал список в Excel, и каждыйгруппа символов% представляет собой список для книги, с различными деталями, такими как ключевые слова и тому подобное.например% T = заголовки.Я хочу создать макрос для поиска по списку и скопировать каждую строку, которая начинается с «% любого маркера, который я выберу», в столбец 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

Я думаю, что у вас будут проблемы с поиском кого-то, кто напишет код для вас.

Но, если вы ищете отправную точку, я бы сказал, что первое, что приходит на умиспользует веб-запрос для импорта данных в рабочую книгу.

Веб-запрос возвращается к Excel '97, но вот кнопка в Excel 2010, с которой можно начать:

Это импортирует ваши данные в таблицу.

Тогда будет простой цикл, чтобы определить, начинается ли строка с%, и анализировать текст соответствующим образом, пока вы не достигнете следующей ячейки, которая начинается с%.

Циклы можно исследовать в файле справки, и есть много статей о SO и в Интернете, которые должны дать вам хорошие идеи.

Начните с этого, напишите некоторый код, а затем опубликуйте то, что вы пишете, если вы все ещеесть проблемы.

Answer 2

Посмотрите, работает ли это для вас. Я использовал веб-запрос и загрузил данные в A1 на листе «Raw»

'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