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
