如何定义 Excel VBA 中特定类别内所有值的 array/collection？

Question

所以我有一个电子表格，在 B51:B220 中有一堆名字，在 H9;H35 中有几个组，在 H51:H220 中每个名字所属的相应组。 B列中的某些名称根据宏填充为红色我仍然不敢相信我自己成功编写了所有内容。

我不确定我到底在做什么，但我试图做的是创建一个特定组中所有红色名称的计数，并且然后在单元格 F9:F35 中列出键中相应组旁边的计数。

我会继续处理这段代码，即使它在这里，并随着我的进步编辑我的 post。

我知道我距离可用的代码还很远，但除了希望和梦想，这是我目前所拥有的：

Sub Team()

Dim TL as Range
Dim GLA as Collection
Dim LA as Variant 
Dim p as Integer 
Dim t as Integer 
p = 0 

‘p is the number of red names 
‘t is the row number used for TL key (column H), team size count (column G), and red name count (column F)
‘LA should be the individual name that is being tested
‘GLA should be an array of each cell from B51:B220 where the value in column H of that same row matches the value of TL

For t = 9 To 35 

TL = Cells(t, 8) 

Set GLA = New Collection

‘add values to GLA here, as a group of all rows in column B where the same rows in column H = TL 
‘I’m guessing that for each value in H51:H220 matching TL, the row number would need to be recorded (as x?)
‘and then added to column 2 to make Cells(x, 2), and then each of these individual cells would be stored in GLA 

For Each LA In GLA 

If LA.Interior.ColorIndex = “22” Then 

p = p + 1 

Else 

p = p 

End If 

‘I’m hoping this will print my p in the appropriate cell but since the code isn’t in running shape yet, i haven’t been able to test it 
Cells(t, 6) = p

Next LA

Next t 

End Sub

编辑我发现了集合对象。现在我只需要帮助弄清楚如何根据值向其添加单元格。

Answer 1

如果您的数据看起来与此类似，则下面的代码会在 F 列中生成计数

Option Explicit

Public Sub CountRedCities()
    Const FR_CTR = 9            'First Row - Countries
    Const LR_CTR = 42           'Last Row  - Countries
    Const FR_CITY = 51          'First Row - Cities
    Const CTR_COL = "H"         'Country Column
    Const CNT_COL = "F"         'Count Column
    Const CTY_COL = "B"         'City Column

    Dim ws As Worksheet:        Set ws = ThisWorkbook.Worksheets("Sheet3")
    Dim ctrCel As Object:       Set ctrCel = CreateObject("Scripting.Dictionary")
    Dim ctrRed As Object:       Set ctrRed = CreateObject("Scripting.Dictionary")

    Dim r As Long
    For r = FR_CTR To LR_CTR  'read all countries (9 to 42) in dictionary
        ctrCel(ws.Cells(r, CTR_COL).Value2) = CNT_COL & r   'reference to F cells
    Next
    Dim country As String, red As Long
    red = RGB(255, 128, 128)  'same as .Interior.ColorIndex = 22
    For r = FR_CITY To ws.Cells(ws.Rows.Count, CTY_COL).End(xlUp).Row
        If ws.Cells(r, CTY_COL).Interior.Color = red Then   'check red cities
            country = ws.Cells(r, CTR_COL)
            ctrRed(country) = ctrRed(country) + 1           'increment red country count
        End If
    Next
    Dim itm As Variant
    For Each itm In ctrRed  'plcace count, based on country key, back to the sheet
        If ctrCel.Exists(itm) Then
            ws.Range(ctrCel(itm)).Value2 = ctrRed(itm)
        Else
            MsgBox "Missing Country in rows " & FR_CTR & " to " & LR_CTR & ": " & itm
        End If
    Next
End Sub

假设

H9:H35 范围内的所有组（国家）都是唯一的
所有城市（B51:B220）和国家（H51:H220）在单元格中只包含一项
国家列中的公式不存在单元格错误
工作 sheet 名字是 "Sheet3"

.

代码有点倒退，但它"divides and conquers"一次完成一个任务

列出 H9:H35 中的国家及其对应的 F 单元格 (F9:F35)
词典中的列表是根据country，作为key
我们并不真正关心这个城市 - 只需要知道它是不是红色的
- 如果红色，我们确实关心它的国家，所以
- 创建一个新字典来跟踪计数（也基于国家/地区）
  - 如果字典中不存在该国家/地区，请将其添加为新项目
  - 否则，只需增加其数量
最后，将所有计数放入每个国家对应的 F 单元格中
- 如果在 H51:H220 中找到的国家/地区不在列表 H9:H35 中，它会在 MsgBox

如何定义 Excel VBA 中特定类别内所有值的 array/collection？

How do I define an array/collection of all the values within a certain category in Excel VBA?

excel

vba

excel-2010