Игнорировать пустые ячейки и исправить ошибку во время выполнения StDev Macro - PullRequest
Новая
       37

Игнорировать пустые ячейки и исправить ошибку во время выполнения StDev Macro

0 голосов
/ 15 октября 2019

У меня есть макрос ниже, который вычисляет StDev, и он работал отлично, но я получил ошибку «не удалось получить свойство StDev класса worksheetfunction» всякий раз, когда у меня есть пустые ячейки. Как я могу исправить это и заставить игнорировать пустые ячейки и переходить к другим ячейкам, которые имеют данные? Все началось с заполнения данных stdev, а затем остановилось, когда появились пустые ячейки. 

Sub NV_stdev()
Dim aSht As Worksheet
    Set aSht = ActiveSheet
Dim firstC, firstR, lastC, lastR As Long
    firstC = 1
    firstR = 1
    lastC = aSht.Cells(firstR, aSht.Columns.Count).End(xlToLeft).Column
    lastR = aSht.Cells(aSht.Rows.Count, firstC).End(xlUp).Row

Dim sa, a, wa, wd, d, sd, mu, n, sigma As String
    sa = "6. Strongly Agree"
    a = "5. Agree"
    wa = "4. Somewhat Agree"
    wd = "3. Somewhat Disagree"
    d = "2. Disagree"
    sd = "1. Strongly Disagree"
    mu = "Average Score"
    n = "Count of Responses"
    sigma = "Std Dev"

Dim saR, aR, waR, wdR, dR, sdR, muR, nR, sigmaR As Range
    Set saR = Cells(1, Application.WorksheetFunction.Match(sa, ActiveSheet.[1:1], 0))
    Set aR = Cells(1, Application.WorksheetFunction.Match(a, ActiveSheet.[1:1], 0))
    Set waR = Cells(1, Application.WorksheetFunction.Match(wa, ActiveSheet.[1:1], 0))
    Set wdR = Cells(1, Application.WorksheetFunction.Match(wd, ActiveSheet.[1:1], 0))
    Set dR = Cells(1, Application.WorksheetFunction.Match(d, ActiveSheet.[1:1], 0))
    Set sdR = Cells(1, Application.WorksheetFunction.Match(sd, ActiveSheet.[1:1], 0))
    Set muR = Cells(1, Application.WorksheetFunction.Match(mu, ActiveSheet.[1:1], 0))
    Set nR = Cells(1, Application.WorksheetFunction.Match(n, ActiveSheet.[1:1], 0))
    Set sigmaR = Cells(1, Application.WorksheetFunction.Match(sigma, ActiveSheet.[1:1], 0))


Dim saN, aN, waN, wdN, dN, sdN As Integer
    saN = Val(Left(saR.Value, 1))
    aN = Val(Left(aR.Value, 1))
    waN = Val(Left(waR.Value, 1))
    wdN = Val(Left(wdR.Value, 1))
    dN = Val(Left(dR.Value, 1))
    sdN = Val(Left(sdR.Value, 1))


Dim responses As Variant, i As Long
For Each itm In Range(Cells(firstR + 1, sigmaR.Column), Cells(lastR, sigmaR.Column))
    i = 1  '<-- initiate array element index
If Cells(itm.Row, nR.Column).Value <> "" And Cells(itm.Row, nR.Column).Value > 0 Then
ReDim responses(1 To Cells(itm.Row, nR.Column).Value) As Variant
    For x = 1 To Cells(itm.Row, saR.Column).Value
        responses(i) = saN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, aR.Column).Value
        responses(i) = aN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, waR.Column).Value
        responses(i) = waN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, wdR.Column).Value
        responses(i) = wdN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, dR.Column).Value
        responses(i) = dN
        i = i + 1
    Next x
    For x = 1 To Cells(itm.Row, sdR.Column).Value
        responses(i) = sdN
        i = i + 1
    Next x

With Cells(itm.Row, sigmaR.Column)
    .Value = Application.WorksheetFunction.StDev(responses)
    .Font.Color = RGB(0, 56, 70)
    .Font.Name = "Calibri"
    .Font.Size = 8
    .NumberFormat = "0.00_#_#;;"
End With
End If

Next itm


End Sub
...