VBA - 如果范围包括值，则数组（i）= 1，循环，总和
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11226992/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA - If Range Includes Value Then Array(i) = 1, Loop, Sum
提问by ESmith5988
I am new to VBA but have previous experience with PHP programming logic and various stats programming syntax. I am trying to write a code to search through a series of cell ranges for a specific value-- if that value exists in the range I want it to insert a 1 into an array, and if it doesn't to insert a 0.
我是 VBA 的新手，但以前有 PHP 编程逻辑和各种统计编程语法的经验。我正在尝试编写代码来搜索特定值的一系列单元格范围——如果该值存在于该范围内，我希望它在数组中插入 1，如果不插入 0。
My data look something like:
我的数据看起来像：
**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
My end goal is to be able to sum the values in the array and count the total number of items with each rating. For example, in the sample above I would want to be able to produce:
我的最终目标是能够对数组中的值求和并计算每个评分的项目总数。例如，在上面的示例中，我希望能够生成：
Number of Items with Rating of 1 = 1
Number of Items with Rating of 2 = 1
Number of Items with Rating of 3 = 2
And so on.
评分为 1 = 1 的项目数
评分为 2 = 1 的项目数
评分为 3 = 2 的项目数
等等。
The code I wrote was:
我写的代码是：
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
I have 5 rows for each item so I thought I could approach this as a repeating, consistent loop. However I get an error when I try to run it - "Application-defined or object-defined error."
每个项目我有 5 行，所以我想我可以把它当作一个重复的、一致的循环来处理。但是，当我尝试运行它时出现错误 - “应用程序定义或对象定义错误。”
I know this is probably not the best way and I am so new to this I don't know where to start in troubleshooting. Any help would be much appreciated.
我知道这可能不是最好的方法，而且我对此很陌生，我不知道从哪里开始进行故障排除。任何帮助将非常感激。
Also if anyone has a good reference for VBA structure/code or a beginner's tutorial, let me know! I haven't had much luck in finding any good references.
另外，如果有人对 VBA 结构/代码或初学者教程有很好的参考，请告诉我！我没有找到任何好的参考资料。
采纳答案by Gaffi
You'll need to change a few things to make this work out. I've changed/added comments to your code below...
您需要更改一些内容才能完成这项工作。我已经在下面的代码中更改/添加了注释...
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
I have used the Scripting.Dictionaryto get this. To use, you'll need to reference the Microsoft Scripting Runtimelibrary (see comments in code). This doesn't do much useful, just prints the results to the immediate window, but you can modify to get what you need, I think.
我已经使用了Scripting.Dictionary来得到这个。要使用，您需要引用该Microsoft Scripting Runtime库（请参阅代码中的注释）。这没有多大用处，只是将结果打印到即时窗口，但我认为您可以修改以获得所需的内容。
回答by Scott Holtzman
If I read what you are asking correctly, you can do this very easily and much more simply, without VBA.
如果我正确阅读了您的要求，则无需 VBA，您就可以非常轻松、更简单地完成此操作。
Here a screenshot of the solution.
这是解决方案的屏幕截图。
Columns H:K perform a CountIf on each Rating Column for each Item (see formula bar). Column G is a simple Sum of H:K for each rating.
列 H:K 对每个项目的每个评级列执行 CountIf（参见公式栏）。G 列是每个评级的 H:K 的简单总和。
UPDATE
更新
To reflect Ratings by Item, the non-VBA approach becomes this:
为了按项目反映评级，非 VBA 方法变为：
You could re-arrange or modify this to make it prettier, probably. Also, you can get a unique list of Item numbers by coping the Item numbers to a new range and using remove duplicates (XL2007 and above) or Advanced Filter > Unique Values (XL2003). Also, if you are on XL 2003, the CountIFs won't work, you need to use a =Count(If(array formula. I can explain if need be.
您可能可以重新安排或修改它以使其更漂亮。此外，您可以通过将项目编号复制到新范围并使用删除重复项（XL2007 及更高版本）或高级过滤器 > 唯一值 (XL2003) 来获取项目编号的唯一列表。此外，如果您使用的是 XL 2003，CountIFs 将无法工作，您需要使用=Count(If(数组公式。如果需要，我可以解释。
