SqlCelFuncs

play

SqlCelFuncs即SqlCel函数。将SqlCel完整版的函数部分独立出来就产生了SqlCelFuncs。

SqlCel函数封装了很多我们在开发时的常用功能。它可以让数据库操作,文本处理和网页爬虫变得非常简单。同时它可实现许多VBA实现不了的功能比如以数据集函数为代表的内存计算和数组处理及多线程等。

SqlCel函数主要分数据集函数、数据库函数、字符串函数、数组函数、正则函数、网页爬虫函数6大类,另外还有一个字典函数、一个fso函数、两个线程函数和两个错误处理函数共92个函数。

SqlCel函数可以通过VBA直接调用。

用SqlCel函数开发出来的VBA作品需有SqlCelFuncs或SqlCel完整版作为运行环境才可以正常运行,庆幸的是SqlCelFuncs是完全免费的。

SqlCelFuncs安装后在Excel/WPS中没有SqlCel选项卡,您可以通过检查Com加载项对话框(文件 -> 选项 -> 加载项 -> COM加载项 -> 转到 或点击“开发工具”选项卡下的COM加载项)来判断SqlCelFuncs是否安装成功。如下:

sqlcelfuncsinstall

如果SqlCelFuncs前面的复选框正常勾选说明已安装成功。

打开Visual Basic编辑器按住Ctrl+G弹出立即窗口在里面录入以下代码可调出SqlCel函数对话框:

Application.COMAddIns("SqlcelAddin").Object.show

如下:

funcspanel

可在该对话框中学习SqlCel函数的使用,在开发的过程中也可以参考该对话框使用SqlCel函数。

举几个SqlCel函数的使用样例:

使用SqlCel函数首先需在模块中录入以下代码

Public Function s() As Object
    Set s= Application.COMAddIns("SqlCelAddIn").Object
End Function

接下来我们就可以引用SqlCel函数了

Public Function s() As Object
    Set s = Application.COMAddIns("SqlCelAddIn").Object
End Function

Sub SqlCelFuncsExamps()
    Dim rndstr As String
    rndstr = s.rndstr(10)
    Debug.Print rndstr   '生成一个随机字符串

    Dim Str As String
    Str = "ufokddQQkwkt"
    Debug.Print s.ReplaceToUpper(Str, "k")  '输出ufoKddQQKwKt
    Debug.Print s.Reverse(Str)  '输出tkwkQQddkofu

    Dim strbld As Object
    Set strbld = s.strbuilder   '定义一个StringBuilder对象
    Set strbld = s.strappend(strbld, Str)  '追加文本
    Debug.Print s.tostr(strbld) '将对象转换为String

    Dim dic As Object
    Set dic = s.newdic   '定义一个字典
    dic.Add 1, "a"
    Debug.Print dic(1)

    Dim fso As Object
    Set fso = s.newfso   '定义一个fso对象
    Debug.Print fso.folderexists("D:\Program Files") '判断文件夹是否存在

    Dim arr() As String
    arr = s.regmatches("9d0k2", "\d")  '使用正则表达式
    Debug.Print UBound(arr)  '输出2
End Sub

这是一个非常简单的样例,接下来再给出一个复杂一点的样例

Private arr1 As String, tparr, arr(13)

Public Function s() As Object
    Set s = Application.COMAddIns("SqlCelAddIn").Object
End Function

'**********多线程爬取(速度更快)
Sub AnjukeCrawMultiThread()
    Range("a1:n1") = Array("城市", "区", "镇", "地址", "小区", "建造日期", "房型", "楼层", "面积", "特点", "总价", "单价", "业主", "描述")
    Dim pg As Integer, arr()
    For pg = 1 To 5
        ReDim Preserve arr(pg - 1)
        arr(pg - 1) = Array("getNodes", pg)
    Next pg
    s.multithread arr, True
End Sub

'*********单线程爬取(容易控制)
Sub AnjukeCrawSingleThread()
    Range("a1:n1") = Array("城市", "区", "镇", "地址", "小区", "建造日期", "房型", "楼层", "面积", "特点", "总价", "单价", "业主", "描述")
    Dim pg As Integer
    For pg = 1 To 5
        Call getNodes(pg)
    Next pg
End Sub

Sub getNodes(pg As Integer)
    Dim doc As Variant, bfstr As String, lastR As Long, i As Integer
    Dim tpnode As String, tpstr As String, url As String
    url = "https://shanghai.anjuke.com/sale/pudong/p"
    bfstr = "/html[1]/body[1]/div[1]/div[2]/div[4]/ul[1]/"  '通过标签路径获取标签
    Set doc = s.getdoc(url & pg)
    Erase arr()
    For i = 1 To 60
        arr(0) = "上海"
        tpstr = s.getnode(doc, bfstr & "li[" & i & "]/div[2]/div[3]")
        tparr = Split(tpstr, "-")
        arr1 = tparr(0)
        tryArr1
        arr(2) = tparr(1)
        tryArr3
        arr(4) = Split(tparr(0), " ")(0)
        arr(5) = s.getnode(doc, bfstr & "li[" & i & "]/div[2]/div[2]/span[4]")
        arr(6) = s.getnode(doc, bfstr & "li[" & i & "]/div[2]/div[2]/span[1]")
        arr(7) = s.getnode(doc, bfstr & "li[" & i & "]/div[2]/div[2]/span[3]")
        arr(8) = s.getnode(doc, bfstr & "li[" & i & "]/div[2]/div[2]/span[2]")
        arr(9) = s.getnode(doc, bfstr & "li[" & i & "]/div[2]/div[4]")
        arr(10) = s.getnode(doc, bfstr & "li[" & i & "]/div[3]/span[1]")
        arr(11) = s.getnode(doc, bfstr & "li[" & i & "]/div[3]/span[2]")
        arr(12) = s.getnode(doc, bfstr & "li[" & i & "]/div[2]/div[2]/span[5]")
        tryArr12
        arr(13) = s.getnode(doc, bfstr & "li[" & i & "]/div[2]/div[1]/a[1]")
        lastR = Cells(1048576, 1).End(xlUp).Row + 1
        Range("A" & lastR & ":N" & lastR).Value = arr
    Next i
    lastR = Cells(1048576, 1).End(xlUp).Row + 1
    Range("A" & lastR).Select
    DoEvents
End Sub

Sub tryArr1()
    On Error GoTo line
    arr(1) = Split(tparr(0), ";")(2)
    Exit Sub
line:
    arr(1) = ""
End Sub

Sub tryArr12()
    On Error GoTo line
    arr(12) = Split(arr(12), ";")(1)
    Exit Sub
line:
    arr(12) = ""
End Sub

Sub tryArr3()
    On Error GoTo line
    arr(3) = tparr(2)
    Exit Sub
line:
    arr(3) = ""
End Sub

以上样例可实现多线程爬取安居客的14个字段。我们可以看到SqlCel的爬虫函数开发效率非常高效且易于维护。现在我们爬取了上海市每个区的房源信息如下: anjukedata 现在我们又要做一件事情就是把这些信息合并到一张表中并导出一个txt文件。我们可以新建一个表,并录入以下代码:

Sub CombineAndExport()
    Dim lastR As Long, i As Integer, arr
    Dim qax As Variant
    For i = 1 To Sheets.Count - 1
        Set qax = s.rngtoqax(Sheets(i).Range("a1").CurrentRegion, True)
        If i = 1 Then arr = s.qaxtoarray(qax, True) Else arr = s.qaxtoarray(qax, False)
        lastR = Cells(1048576, 1).End(xlUp).Row + 1
        s.arraytoexcel arr, Cells(lastR, 1), True
    Next i
    Set qax = s.rngtoqax(Range("a2").CurrentRegion, True)
    s.qaxtofile qax, "e://anjuke.txt", "|" '将数据写入竖线分隔符的文本中
End Sub

数据集函数非常强大,可实现内存数据的计算,查询,修改和读写等。

点击以下链接下载SqlCelFuncs:

SqlCelFuncs.V2.0.exe 4.12M