Question

我是VBA的新手，但之前有PHP编程逻辑和各种统计编程语法的经验。我正在尝试编写代码来搜索特定值的一系列单元格范围 - 如果该值存在于我希望它将1插入数组的范围内，并且如果它不插入0。

我的数据类似于：

**Item  R1  R2**
1121    1   3
1121    2   
1121        
1121    3   2
1121    3   
1122    4   5
1122    3   5
1122    5   
1122    4   
1122    5

我的最终目标是能够对数组中的值求和，并计算每个评级的项目总数。例如，在上面的示例中，我希望能够生成：

评分为1 = 1的项目数

评分为2 = 1的项目数

评分为3 = 2的项目数

等等。

我写的代码是：

Sub Items()

    Dim myArray() As Variant
    Dim i As Integer
    Dim k As Integer
    i = 0
    k = 0
    R5 = Range("G(2+k):H(6+k)")
    mycount = Application.WorksheetFunction.Sum(myArray)


    Sheets("Operational").Select

    For Each R5 In Range("G2:H206")
        ReDim myArray(0 To i)
        myArray(i) = Cell.Value
        i = i + 1
        k = k + 4

        R5.Select
        If R5.Value = "1" Then
            myArray(i) = 1
        Else
            myArray(i) = 0
        End If
    Next

End Sub

每个项目我有5行，所以我认为我可以将其视为一个重复的，一致的循环。但是当我尝试运行它时出现错误 - “应用程序定义的或对象定义的错误。”

我知道这可能不是最好的方式，我对此很新，我不知道从哪里开始进行故障排除。任何帮助将非常感激。

如果有人对VBA结构/代码或初学者教程有很好的参考，请告诉我！我找到任何好的参考资料都没有多少运气。

Answer 1

如果我正确地阅读了您的要求，那么您可以非常轻松地完成此操作，而无需VBA。

此处是解决方案的屏幕截图。

列H：K对每个项目的每个评级列执行一次CountIf（参见公式栏）。 G列是每个评级的简单H：K总和。

enter image description here

<强>更新

为了按项目反映评级，非VBA方法变为：

enter image description here

你可以重新安排或修改它，使其更漂亮。此外，您可以通过将项目编号复制到新范围并使用删除重复项（XL2007及更高版本）或高级过滤器＆gt;来获取项目编号的唯一列表。唯一值（XL2003）。此外，如果您使用的是XL 2003，则CountIF将无效，您需要使用 = Count（If（数组公式。我可以解释是否需要。

Answer 2

您需要更改一些内容才能使其成功。我在下面的代码中更改/添加了评论...

Option Explicit ' Helps with ensuring all variables are declared correctly.

' Need to add reference to 'Microsoft Scripting Runtime' when using Scripting.Dictionary

Sub Items()

Dim Ratings As Range
Dim cell As Range
Dim ItemTracking As New Scripting.Dictionary
Dim DictKey As Variant

    ' Use SET to assign objects
    Set Ratings = ActiveSheet.Range("B2:H206") ' The Range takes (in this case) a complete STRING argument, which can be manipulated with variables through concatenation with '&'.

    For Each cell In Ratings ' First column is R1, second is R2, etc.
        If Len(Trim$(ActiveSheet.Range("A" & cell.Row).Value)) > 0 Then ' Make sure we actually have an item before continuing...
            If Val(cell.Value) > 0 Then ' Make sure we have a rating before continuing...
                DictKey = Trim$(ActiveSheet.Range("A" & cell.Row).Value) & "R" & cell.Column - 1 & "V" & Val(cell.Value) ' If you need a more descriptive output than '1121 R1V1`, then just change this to match. Be careful of the string concatenation/variable usage.
                If ItemTracking.Exists(DictKey) Then ' When using a Dictionary (versus a Collection), we have the nifty Exists() function to help us see if we already have something.
                    ' If we do, add to it...
                    ItemTracking.Item(DictKey) = ItemTracking.Item(DictKey) + 1
                Else
                    ' Else, we do not, add it to the Dictionary.
                    ItemTracking.Add DictKey, 1
                End If
            End If
        End If
    Next

    For Each DictKey In ItemTracking
        Debug.Print DictKey & " - " & ItemTracking.Item(DictKey)
    Next

End Sub

我已使用Scripting.Dictionary来获取此信息。要使用，您需要引用Microsoft Scripting Runtime库（请参阅代码中的注释）。这没有什么用处，只是将结果打印到即时窗口，但我认为你可以修改以获得你需要的东西。

VBA - 如果Range包含值则Array（i）= 1，Loop，Sum

2 个答案: