VBA – 如果范围包含值，则数组（i）= 1，循环，和
我是VBA的新手，但以前有过使用PHP编程逻辑和各种统计编程语法的经验。 我想写一个代码来search特定值的一系列单元格区域 – 如果该值存在于我希望它插入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结构/代码或初学者教程有很好的参考，请告诉我！ 我没有find任何好的参考运气。
你需要改变一些东西来完成这个工作。 我在下面的代码中更改/添加了评论…
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。
这里是解决scheme的截图。
列H：K在每个项目的每个评级列上执行CountIf（请参阅公式栏）。 G列是每个评分的H：K的简单和。
UPDATE
为了反映Item by Ratings，非VBA方法变成这样：
你可能会重新安排或修改，使其更漂亮，可能。 此外，您可以通过将商品编号复制到新范围并使用删除重复项（XL2007及以上版本）或高级筛选>唯一值（XL2003）来获得唯一商品编号列表。 另外，如果你在XL 2003上，CountIFs将不起作用，你需要使用一个= Count（如果（数组公式），我可以解释，如果需要的话。