带有IF参数或索引匹配的STDEV.P

时间:2016-10-25 10:14:53

标签: excel vba excel-vba

对于stdev函数,我非常需要帮助。

我需要帮助编写一个计算标准偏差的子函数,但仅限于F列的负数。我花了几个小时寻找解决方案,但我还没有找到一个具有IF函数的函数,因为我只想要负数。

所以我正在考虑在IF单元中使用IF函数< 0

以下是截至目前的代码。

Dim ArtikelNummer As Variant    
 Sub lagerdata()

'Definera
    Dim NewSheet As Worksheet
    Dim RowCount As Long
    Dim i As Long, x As Long
    Dim check_value As Range

'Användar input för artikelnummer
    ArtikelNummer = InputBox("Skriv in artikelnummer", "Artikelsortering")

'Skapa ark med namn från input
    Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    NewSheet.Name = ArtikelNummer
    Range("A1:W1").Interior.ColorIndex = 37
    Range("A1:W1").Characters.Font.Bold = True
    Dim cell As Range

'Börja på rad 2, dvs under texterna
    x = 2
'Kopiera in data från "Data"-arket till det nya Artikelnummer-arket
    With Worksheets("Data")
        RowCount = .Cells(.Cells.Rows.Count, "B").End(xlUp).Row
        For i = 1 To RowCount
            If .Cells(i, 2) = Val(ArtikelNummer) Then
                .Cells(i, 2).Columns("D:D").Copy Destination:= _
                    NewSheet.Cells(x, 1)
                .Cells(i, 2).Columns("N:N").Copy Destination:= _
                    NewSheet.Cells(x, 2)
                .Cells(i, 2).Columns("C:C").Copy Destination:= _
                    NewSheet.Cells(x, 5)
                x = x + 1
            End If
        Next i
    End With

    End Sub

1 个答案:

答案 0 :(得分:2)

我不确定你的代码在哪里需要它,但是这个函数应该做我认为的技巧:

Function stdevNegatives()
    Dim arr1 As Variant
    arr1 = Range("F1:F20")
    Dim arr2() As Double
    ReDim arr2(1 To 1)
    Dim i As Long
    For i = 1 To UBound(arr1)
        If arr1(i, 1) < 0 Then
            ReDim Preserve arr2(1 To UBound(arr2) + 1)
            arr2(UBound(arr2)) = arr1(i, 1)
        End If
    Next i
    ReDim Preserve arr2(1 To UBound(arr2) - 1)
    stdevNegatives = Application.WorksheetFunction.StDev_P(arr2)
End Function

您可能需要将其传递给工作表以获得正确的范围(并将F20更改为您当然需要的任何内容)。