如何在Excel VBA中定义某个类别中所有值的数组/集合?

时间:2018-06-15 20:28:45

标签: excel excel-vba excel-2010 vba

所以我有一个电子表格,在B51中有一堆名字:B220,H9中的几个组; H35,以及每个名称所属的相应组,在H51:H220中。 B列中的一些名称是基于一个宏填充红色的我仍然无法相信我自己写了所有。

我不确定我到底在做什么,但是我尝试要做的是创建某个组中所有红色名称的计数,然后列出该计数下一个在密钥中的相应组中,在单元格F9:F35中。

即使它在这里,我也会继续处理这段代码,并在我进一步推进时编辑我的帖子。

我知道我仍然远离可用的代码,但到目前为止,除了希望和梦想之外,这是我的目标:

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 

修改 我发现了集合对象。现在我只需要帮助找出如何根据价值添加单元格。

1 个答案:

答案 0 :(得分:0)

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

data

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)仅包含单元格中的一个项目
  • 国家/地区列中的公式不会生成单元格错误
  • 工作表名称为"Sheet3"

代码有点倒退,但它会分裂和征服"当时的一项任务

  • H9:H35及其相应的 F 单元格(F9:F35
  • 中列出国家/地区列表
  • 字典中的列表基于country,作为键
  • 我们并不关心这个城市 - 只需要知道它是否是红色的
    • 如果是红色,我们会关心其国家,所以
    • 创建一个跟踪计数的新词典(也基于国家/地区)
      • 如果该国家/地区尚不存在,请将其添加为新项目
      • 其他,只是增加点数
  • 最后,将所有计数放在每个国家/地区的相应F单元格中
    • 如果在H51:H220中找不到H9:H35中找到的国家/地区,则会在列表README.md中找不到该国家/地区