2

我是 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 结构/代码或初学者教程有很好的参考，请告诉我！我没有太多运气找到任何好的参考资料。

4

2 回答 2

2

如果我正确阅读了您的要求，则无需 VBA，您就可以非常轻松且更简单地做到这一点。

这是解决方案的屏幕截图。

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

在此处输入图像描述

更新

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

在此处输入图像描述

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

于 2012-06-27T16:09:58.807 回答
1

您需要更改一些内容才能完成这项工作。我在下面的代码中更改/添加了注释...

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库（请参阅代码中的注释）。这并没有多大用处，只是将结果打印到即时窗口，但我认为你可以修改以获得你需要的东西。

于 2012-06-27T13:19:12.087 回答