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 — 127.0.0.1