Question

我有一个访问数据库，其中包含对维修服务平台的审核。钻机分级有17种不同的标准。多家公司提供钻井平台，我设计了一个查询，总计每个公司的满意/不满意的分数和标准，以达到每个标准的百分比分数。我正在将数据导出为excel并自动为每个公司的每个标准创建图表，但我也希望在访问中为每个标准提供方便的斜率，以便在他们的总分后，我可以指示他们是否正在改进。

使用此网站作为基础（http://bytes.com/topic/access/answers/913231-creating-slope-formula-access），我已根据我的目的调整了代码。

Public Sub slopeTest()
' Excel: slope(known_y's, known_x's)
'   known_y's - an array or cell range of numeric dependent data points
'   known_x's - the set of independent data points
'
'   Below creates two arrays to input into excel.slope function

Dim db As Database
Dim rs As Recordset
Dim qdf As QueryDef

Set db = CurrentDb

Dim arrX() As Double
Dim arrY() As Double
'Make sure to 1st set a Reference to the Microsoft Excel XX.X Object Library
Dim objExcel As Excel.Application
Set objExcel = CreateObject("Excel.Application")

'for each query
    'create sql to pull that query data into a recordset
        'loop recordset
            'setup x,y array

For Each qdf In db.QueryDefs
   ‘the related queries are numbered ‘xx – criteria’
    If IsNumeric(Left(qdf.Name, 2)) Then
    ‘the table graphCompanySource contains the company,associated query name,date of inspection,
 satisfactory tally,unsatisfactory tally, totalcount tally, percent satisfactory – some of the data
 was inherited so the dates are still in text format (thus the CDate())
        strQuerySQL = "SELECT * FROM [graphCompanySource] WHERE [Query] = '" & qdf.Name & "' ORDER BY CDate([InspDate]) Asc;"
        Set rs = db.OpenRecordset(strQuerySQL)
        ‘loop through the recordset expanding the array with each increment
        Do Until rs.EOF
            ctr = ctr + 1
            ReDim Preserve arrX(ctr)
            ReDim Preserve arrY(ctr)
            Debug.Print qdf.Name, ctr, rs!InspDate, rs!PercSat, UBound(arrX)
            ‘arrX will just contain a sequential count
            arrX(ctr) = ctr
‘arrY should have the percentSatisfactory for each date
            arrY(ctr) = rs!PercSat

            rs.MoveNext
        Loop
        ‘here I was just checking to make sure that the arrays were populated correctly
        For x = 1 To UBound(arrX)
            Debug.Print arrX(x), arrY(x)
        Next x
       ‘print the slope
        MsgBox qdf.Name & ": " & Round(objExcel.Application.slope(arrY, arrX), 6)
    End If

   ctr = 0
Next qdf

Set db = Nothing
Set rs = Nothing
Set qdf = Nothing
Set objExcel = Nothing

End Sub

因此，对于第一个度量，上面的代码产生的斜率为.046703。我也尝试使用'objExcel.WorksheetFunction.Slope（arrY，arrX）并得到了相同的答案。显示数组内容的调试产生：

1             0.5
2             1
3             1
4             1
5             1
6             1
7             1
8             1
9             1
10            1
11            1
12            1

已构建的图形显示斜率为.0192，当我在excel中对上述数字执行斜率函数时，我也返回相同的斜率。

在更多变化的集合上：

1             0.6 
2             0.9 
3             0.5 
4             1 
5             1 
6             0.84 
7             0.4 
8             1 
9             1 
10            1 
11            1 
12            1 
13            1 
14            0.8 
15            0.9 
16            1 
17            1 
18            1 
19            1 
20            1 
21            1

Access返回0.02323，Excel中的相同数字和图表上显示的斜率返回.0144

在这一点上，我无法找到一个解决方案，为什么斜坡会以原来的方式返回，我不确定我是否遗漏了什么。

有什么想法吗？

Answer 1

VBA数组中默认的第一个索引是0，因此该代码忽略第一行中的数据点。

Access-VBA：使用excel.application.slope确定斜率

1 个答案: