计算企业规模

  1. Function qiyeguimo(hangye As Range, shouru As Range, zichan As Range, renshu As Range)
  2. '工信部企业规模(行业,销售收入,资产,从业人数)
  3. Select Case hangye
  4.   Case "农、林、牧、渔业"
  5.      Select Case shouru
  6.         Case Is >= 20000
  7.            qiyeguimo = "大型"
  8.         Case Is >= 500
  9.            qiyeguimo = "中型"
  10.         Case Is >= 50
  11.            qiyeguimo = "小型"
  12.         Case Else
  13.            qiyeguimo = "微型"
  14.      End Select
  15.   Case "工业"
  16.      If WorksheetFunction.And(renshu >= 1000, shouru >= 40000) Then
  17.             qiyeguimo = "大型"
  18.      ElseIf WorksheetFunction.And(renshu >= 300, shouru >= 2000) Then
  19.             qiyeguimo = "中型"
  20.      ElseIf WorksheetFunction.And(renshu >= 20, shouru >= 300) Then
  21.             qiyeguimo = "小型"
  22.      Else:
  23.             qiyeguimo = "微型"
  24.     End If
  25.   Case "建筑业"
  26.     If WorksheetFunction.And(shouru >= 80000, zichan >= 80000) Then
  27.             qiyeguimo = "大型"
  28.     ElseIf WorksheetFunction.And(shouru >= 6000, zichan >= 5000) Then
  29.             qiyeguimo = "中型"
  30.     ElseIf WorksheetFunction.And(shouru >= 300, zichan >= 300) Then
  31.             qiyeguimo = "小型"
  32.     Else:
  33.             qiyeguimo = "微型"
  34.     End If
  35.   Case "批发业"
  36.     If WorksheetFunction.And(renshu >= 200, shouru >= 40000) Then
  37.             qiyeguimo = "大型"
  38.     ElseIf WorksheetFunction.And(renshu >= 20, shouru >= 5000) Then
  39.             qiyeguimo = "中型"
  40.     ElseIf WorksheetFunction.And(renshu >= 5, shouru >= 1000) Then
  41.             qiyeguimo = "小型"
  42.     Else:
  43.             qiyeguimo = "微型"
  44.     End If
  45.   Case "零售业"
  46.     If WorksheetFunction.And(renshu >= 300, shouru >= 20000) Then
  47.             qiyeguimo = "大型"
  48.     ElseIf WorksheetFunction.And(renshu >= 50, shouru >= 500) Then
  49.             qiyeguimo = "中型"
  50.     ElseIf WorksheetFunction.And(renshu >= 10, shouru >= 100) Then
  51.             qiyeguimo = "小型"
  52.     Else:
  53.             qiyeguimo = "微型"
  54.     End If
  55.   Case "交通运输业"
  56.     If WorksheetFunction.And(renshu >= 1000, shouru >= 30000) Then
  57.             qiyeguimo = "大型"
  58.     ElseIf WorksheetFunction.And(renshu >= 300, shouru >= 3000) Then
  59.             qiyeguimo = "中型"
  60.     ElseIf WorksheetFunction.And(renshu >= 20, shouru >= 200) Then
  61.             qiyeguimo = "小型"
  62.     Else:
  63.             qiyeguimo = "微型"
  64.     End If
  65.   Case "仓储业"
  66.     If WorksheetFunction.And(renshu >= 200, shouru >= 30000) Then
  67.             qiyeguimo = "大型"
  68.     ElseIf WorksheetFunction.And(renshu >= 100, shouru >= 1000) Then
  69.             qiyeguimo = "中型"
  70.     ElseIf WorksheetFunction.And(renshu >= 20, shouru >= 100) Then
  71.             qiyeguimo = "小型"
  72.     Else:
  73.             qiyeguimo = "微型"
  74.     End If
  75.   Case "邮政业"
  76.     If WorksheetFunction.And(renshu >= 1000, shouru >= 30000) Then
  77.             qiyeguimo = "大型"
  78.     ElseIf WorksheetFunction.And(renshu >= 300, shouru >= 2000) Then
  79.             qiyeguimo = "中型"
  80.     ElseIf WorksheetFunction.And(renshu >= 20, shouru >= 100) Then
  81.             qiyeguimo = "小型"
  82.     Else:
  83.             qiyeguimo = "微型"
  84.     End If
  85.   Case "住宿业"
  86.     If WorksheetFunction.And(renshu >= 300, shouru >= 10000) Then
  87.             qiyeguimo = "大型"
  88.     ElseIf WorksheetFunction.And(renshu >= 100, shouru >= 2000) Then
  89.             qiyeguimo = "中型"
  90.     ElseIf WorksheetFunction.And(renshu >= 10, shouru >= 100) Then
  91.             qiyeguimo = "小型"
  92.     Else:
  93.             qiyeguimo = "微型"
  94.     End If
  95.   Case "餐饮业"
  96.     If WorksheetFunction.And(renshu >= 300, shouru >= 10000) Then
  97.             qiyeguimo = "大型"
  98.     ElseIf WorksheetFunction.And(renshu >= 100, shouru >= 2000) Then
  99.             qiyeguimo = "中型"
  100.     ElseIf WorksheetFunction.And(renshu >= 10, shouru >= 100) Then
  101.             qiyeguimo = "小型"
  102.     Else:
  103.             qiyeguimo = "微型"
  104.     End If
  105.   Case "信息传输业"
  106.     If WorksheetFunction.And(renshu >= 2000, shouru >= 100000) Then
  107.             qiyeguimo = "大型"
  108.     ElseIf WorksheetFunction.And(renshu >= 100, shouru >= 1000) Then
  109.             qiyeguimo = "中型"
  110.     ElseIf WorksheetFunction.And(renshu >= 10, shouru >= 100) Then
  111.             qiyeguimo = "小型"
  112.     Else:
  113.             qiyeguimo = "微型"
  114.     End If
  115.   Case "软件和信息技术服务业"
  116.     If WorksheetFunction.And(renshu >= 300, shouru >= 10000) Then
  117.             qiyeguimo = "大型"
  118.     ElseIf WorksheetFunction.And(renshu >= 100, shouru >= 1000) Then
  119.             qiyeguimo = "中型"
  120.     ElseIf WorksheetFunction.And(renshu >= 10, shouru >= 50) Then
  121.             qiyeguimo = "小型"
  122.     Else:
  123.             qiyeguimo = "微型"
  124.     End If
  125.   Case "房地产开发经营"
  126.     If WorksheetFunction.And(shouru >= 200000, zichan >= 10000) Then
  127.             qiyeguimo = "大型"
  128.     ElseIf WorksheetFunction.And(shouru >= 1000, zichan >= 5000) Then
  129.             qiyeguimo = "中型"
  130.     ElseIf WorksheetFunction.And(shouru >= 100, zichan >= 2000) Then
  131.             qiyeguimo = "小型"
  132.     Else:
  133.             qiyeguimo = "微型"
  134.     End If
  135.   Case "物业管理"
  136.     If WorksheetFunction.And(renshu >= 1000, shouru >= 5000) Then
  137.             qiyeguimo = "大型"
  138.     ElseIf WorksheetFunction.And(renshu >= 300, shouru >= 1000) Then
  139.             qiyeguimo = "中型"
  140.     ElseIf WorksheetFunction.And(renshu >= 100, shouru >= 500) Then
  141.             qiyeguimo = "小型"
  142.     Else:
  143.             qiyeguimo = "微型"
  144.     End If
  145.   Case "租赁和商务服务业"
  146.     If WorksheetFunction.And(renshu >= 300, zichan >= 120000) Then
  147.             qiyeguimo = "大型"
  148.     ElseIf WorksheetFunction.And(renshu >= 100, zichan >= 8000) Then
  149.             qiyeguimo = "中型"
  150.     ElseIf WorksheetFunction.And(renshu >= 10, zichan >= 100) Then
  151.             qiyeguimo = "小型"
  152.     Else:
  153.             qiyeguimo = "微型"
  154.     End If
  155.   Case "其他未列明行业"
  156.     Select Case renshu
  157.       Case Is >= 300
  158.           qiyeguimo = "大型"
  159.       Case Is >= 100
  160.           qiyeguimo = "中型"
  161.       Case Is >= 10
  162.           qiyeguimo = "小型"
  163.       Case Else
  164.           qiyeguimo = "微型"
  165.      End Select
  166.   End Select
  167. End Function

借助SQL计算户数

Public lian  As String
Function startconn()
Dim cnn As ADODB.Connection
    Set cnn = New ADODB.Connection
     '创建连接设置字符串,用OLEDB方式连接

    lian = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0 Macro;" _
                            & "HDR=yes;" _
                            & "IMEX=1';" _
                            & "Data Source=" & ThisWorkbook.FullName

       'HDR=Yes，代表 Excel 档中的工作表第一行是标题栏,No，代表 Excel 档中的工作表无标题行
       'IMEX 汇入模式  0 只读  1 只写   2 可读写
       'Data Source  存储查询数据来源的工作薄名称
       'Provider 连接方式或连接提供程序  Extended Properties 连接方式的扩展属性、证书
       'Extended Properties='Excel 8.0  ---EXECL 2003
       'Extended Properties='Excel 12.0  ---EXECL 2007及以上
       'Extended Properties='Excel 8.0  ---EXECL 2003

       'File Type (extension)                              Extended Properties
       '------------------------------------------------------------------------
       'Excel 97-2003 Workbook (.xls)                      "Excel 8.0"
       'Excel Workbook (.xlsx)                             "Excel 12.0 Xml"
       'Excel Macro-enabled workbook (.xlsm)               "Excel 12.0 Macro"
       'Excel Non-XML binary workbook (.xlsb)              "Excel 12.0"
    cnn.Open lian
        '    ' 创建连接设置字符串,用ODBC方式打开连接.
        '    Dim lian As String
        '    lian = "Driver={Microsoft Excel Driver(*.xls,*xlsx,*.xlsm,*xlsb)};" _
        '                     & "ReadOnly=False;" _
        '                     & "DBQ=" & ThisWorkbook.FullName'
        '         'driver ODBC连接驱动属性
        '         'ReadOnly 相当于IMEX属性
        '         'DBQ 连接数据源
        '    con.Open lian

            ' 检查是否完成连接
        '    If cnn.State = adStateOpen Then
        '       'cnn.State -->adstratclosed 关闭状态  adstartopen  打开状态
        '                 'adstartconnecting 连接中     adstartexecuting   执行命令中
        '        MsgBox "Welcome to Pubs!"
        '    Else
        '        MsgBox "Sorry. No Pubs today."
        '    End If
    '关闭connection对象
    cnn.Close
    '销毁连接
    Set cnn = Nothing
End Function

Function jilurecord(SqlCommandStr)
 Dim jilu As ADODB.Recordset
     Set jilu = New ADODB.Recordset
     jilu.Open SqlCommandStr, lian
        '   open方法：open <SQL命令文本或数据源>,<activeconnection>,[cursortype],[locktype],[options 参数选项]
        '   <activeconnection> 指定用于查询的连接设置,可以OPEN方法以前将一个字符串赋值给Recordset的activeconnection属性，那么该记录集则自动产生
        '      一个connection对像
        '   [cursortype]  打开记录集时的数据指针类型：默认值为adopenforwardonly
        '            adopenforwardonly-->只能向下移动且不能修改，常规查询
        '            adopenstatic   -->静态指针，用于脱机记录集，允许完全操作
        '             此参数不同于OPEN方法之前设置的Recordset的cursorlocation属性(规定recordset使用的数据指针类型：
        '                                           aduserclient --客户端数据指针
        '                                           aduseserver-- 服务器端数据指针，默认值）
        '   [locktype]  打开记录时的数据源锁定类型:
        '        adlockreadonly:常规查询使用，锁定源记录
        '        adlockbatchoptimistic:脱机记录集使用，开放式批量更新
        '   [options 参数选项] -- SQL命令类型 or 执行方式   connection对象的Execute方法设置相同
    Do While Not jilu.EOF  '如果指针不是未尾则表示记录内有数据
    'EOF --指针位于记录集最后一条记录之后  BOF --指针位于记录集第一条记录之前（Recordset对象的属性）
      jilurecord = jilu.Fields(0).Value
       'Fields对象：记录集所包括的所有字段，带有Name,Item，Value等属性与Append等方法
       jilu.MoveNext
       'Move方法：
       '    MoveFirst：移动到第一条记录
       '    MoveLast: 移动最后一条记录
       '    MoveNext:移动到下一条记录
    Loop
    'jilu.Filter = "存货编码 like 'A0202*'"
      '.Filter属性：对记录按一定条件进行选择过滤但不删除数据，将过滤条件设置为空则恢复所有数据，多个条件可以使用逻辑运算符进行联接
   'Do While Not jilu.EOF
   '   MsgBox jilu.Fields(0).Value
   'Loop

    '关闭Recordset
    jilu.Close
    '销毁Recordset
    Set jilu = Nothing
End Function

Function myrzqimohushu(x As String, Optional y As String = 1) As Integer
'期末户数计算 参数y默认为1统计所有融资性期末在保户数
    startconn

    '设置SQL命令的字符串
    Dim SqlCommandStr, sss As String

    SqlCommandStr = "select count(担保客户) as 担保户数 from(select distinct 担保人 as 担保客户 from(select  [*被担保人] as 担保人 from"

    'If z = 1 Then
     sss = " [融资性$] where ([辅助列：实际解保日期] >" & "#" & x & "#" & ") and ([*担保责任发生日期] <= " & "#" & x & "#"
    'Else
    ' sss = " [债券发行担保$] where ([实际解保日期] >" & "#" & x & "#" & ") and ([*担保责任发生日期] <= " & "#" & x & "#"
    'End If
    If y = 1 Then
     SqlCommandStr = SqlCommandStr & sss & ")))"
    Else
     SqlCommandStr = SqlCommandStr & sss & ") " & "AND [*企业规模]=" & "'" & "中型企业" & "'" & "))"
    '参数y设置为非1（比如0），统计期末中型企业在保户数
    End If

    '[主材汇总$]--连接数据源中的具体表名，可指定具体的range，直接跟在表名后即可 ，也可使用在表中定义的名称
    '如果设置第一行为标题，则可直接使用第一行数据为字段名
    'SqlCommandStr = "SELECT 存货名称 from [主材汇总$A1:M100] where 存货编码='A01020506001500200'"

    '执行SQl命令
      'A、不要返回值
    'cnn.Execute SqlCommandStr
        '   Execute方法： Execute <SQL命令文本>,[recordsaffected 查询作用范围],[options 参数选项]
        '   [recordsaffected 查询作用范围] 如：1NumAffected  仅第一条记录
        '   [options 参数选项] -- SQL命令类型 or 执行方式
        '    SQL命令类型:
        '           adcomdtext:     原始 SQL字符串
        '           adcomdtable:    表的名称，向连接提供驱动提供类似 SELECT *　from_name的语句
        '           adcmdstoreproc: 存储过程
        '           adcmdtabledirect:表名，不同于table的是不会产生类似 SELECT *　from_name的SQL语句
        '   SQL命令执行方式：
        '           adasyncexecute:   异步执行命令，立即执行代码
        '           adexecutenorecords: 不构建recoredset对像
        '       如：adcmdtext or adexecutenorecords
      'B、需要返回值
       myrzqimohushu = jilurecord(SqlCommandStr)

End Function

Function myrzleijihushu(enddate As String, Optional y As Integer = 1) As Integer
  '参数y默认为1，统计所有融资性累计户数（每年需修改年初日期）。参数y设置为0，统计中型企业累计户数
    startconn

    '设置SQL命令的字符串
     Dim SqlCommandStr As String
     SqlCommandStr = "select count(担保客户) as 担保户数 from(select distinct 担保人 as 担保客户 from(select  [*被担保人] as 担保人 from [融资性$] where "
    If y = 1 Then
    SqlCommandStr = SqlCommandStr & "[*担保责任发生日期] between #" & [年度] & "-01-01# AND " & "#" & enddate & "#" & "))"
    Else
    SqlCommandStr = SqlCommandStr & "[*担保责任发生日期] between #" & [年度] & "-01-01# AND " & "#" & enddate & "#" & " " & "AND [*企业规模]=" & "'" & "中型企业" & "'" & "))"
    End If

    myrzleijihushu = jilurecord(SqlCommandStr)
End Function