Инструменты пользователя

Инструменты сайта


other:vba1

VBA макрос

Function countUrl(url As String, st As String, en As String) As Integer
        Dim temp As Worksheet
        Set temp = ThisWorkbook.Sheets("temp")
        temp.Activate
        
        temp.Cells.Delete
        
        With temp.QueryTables.Add(Connection:= _
        "URL;" & url, Destination:=Range( _
        "A1"))
        .Name = "temp123"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
      
    
    Dim s As String
    Dim r_count, count As Integer
    r_count = 0
    count = 0
    Dim startflag As Boolean
    Dim endflag As Boolean
    endflag = True
    startflag = False
    
    Dim i As Integer
    i = 1
    Do While (r_count < 100 And endflag)
        s = temp.Cells(i, 1)
        If s = "" Then
            r_count = r_count + 1
        Else
            If en = s Then
                endflag = False
            End If
            If startflag Then
                count = count + Len(s)
            End If
            r_count = 0
            If st = s Then
                startflag = True
            End If

        End If
        i = i + 1
    Loop
    countUrl = count
End Function
Sub count()
    Dim start As Worksheet
    Dim st As String
    Dim en As String
    st = Range("start").Cells(1, 1).Value
    en = Range("end").Cells(1, 1).Value
    
    Set start = ThisWorkbook.Sheets("start")
        ind = 1
        While start.Cells(ind, 1) <> ""
            start.Cells(ind, 2).Value = countUrl(start.Cells(ind, 1), st, en)
            ind = ind + 1
        Wend
        start.Activate

End Sub
other/vba1.txt · Последние изменения: 2017/03/23 21:59 (внешнее изменение)