字典示例

Sub Test()
  Dim arr  '保存原始数据
  Dim intI As Integer
  Dim intJ As Integer
  Dim d As Dictionary  '字典对象
  Set d = New Dictionary

  On Error Resume Next
  '获取原始数据
  arr = ActiveSheet.Range("B2:H10").Value
  For intI = 1 To UBound(arr, 1)
    For intJ = 1 To UBound(arr, 2)
      '遍历每个原始数据，如果不为空
      If arr(intI, intJ) <> "" Then
        '如果当前数据作为字典的键已经存在，个数加1
        If d.Exists(arr(intI, intJ)) Then
          d(arr(intI, intJ)) = d(arr(intI, intJ)) + 1
        Else  '如果不存在，添加键值对，个数为1
          d.Add arr(intI, intJ), 1
        End If
      End If
    Next
  Next

  '输出所有键，即唯一姓名及其对应的出现个数
  ActiveSheet.Range("J2").Resize(d.Count, 1).Value = _
          Application.WorksheetFunction.Transpose(d.Keys)
  ActiveSheet.Range("K2").Resize(d.Count, 1).Value = _
          Application.WorksheetFunction.Transpose(d.Items)
End Sub

import xlwings as xw  #导入xlwings包
#从constants类中导入Direction
from xlwings.constants import Direction
import os  #导入os包
#获取本py文件的当前路径
root = os.getcwd()
#创建Excel应用，可见，没有工作簿
app=xw.App(visible=True, add_book=False)
#打开数据文件，可写
bk=app.books.open(fullname=root+\
    r'\多行数据中唯一值出现次数汇总.xlsx',read_only=False)
sht=bk.sheets(1)  #获取第1个工作表
d={}
arr=sht.range('B2:H10';).value  #获取数据
for i in range(len(arr)):  #行
    for j in range(len(arr[0])):  #列
        #遍历每个原始数据，如果不为空
        if arr[i][j] is not None:
            if arr[i][j] in d:  #如果在字典中已经存在
                d[arr[i][j]]=d[arr[i][j]]+1  #个数加1
            else:  #如果不存在
                d[arr[i][j]]=1  #添加键值对，值为1
#输出所有键，即唯一姓名及其对应的出现个数
sht.range('J2').options(transpose=True).value=list(d.keys())
sht.range('K2').options(transpose=True).value=list(d.values())

Sub Test()
  Dim intI As Long
  Dim intR As Long
  Dim d As Dictionary  '字典对象
  Set d = New Dictionary
  Dim sht As Object
  Set sht = ActiveSheet

  On Error Resume Next
  intR = sht.Range("A1").End(xlDown).Row  '第1列数据行数
  For intI = 2 To intR
    '把第1列数据添加到字典，球员名为键，值为“金球奖”
    d.Add sht.Cells(intI, 1).Value, "金球奖"
  Next
  intR = sht.Range("B1").End(xlDown).Row  '第2列数据行数
  For intI = 2 To intR
    '判断第2列球员名在字典中是否已经存在
    If d.Exists(sht.Cells(intI, 2).Value) Then
      '如果已经存在，则对应键的值追加“,最佳球员”字符串
      d(sht.Cells(intI, 2).Value) = _
              d(sht.Cells(intI, 2).Value) & ",最佳球员"
    Else
      '如果不存在，则添加新的键值对
      d.Add sht.Cells(intI, 2).Value, "最佳球员"
    End If
  Next
  intR = sht.Range("C1").End(xlDown).Row  '第3列数据行数
  For intI = 2 To intR
    '判断第3列球员名在字典中是否已经存在
    If d.Exists(sht.Cells(intI, 3).Value) Then
      '如果已经存在，则对应键的值追加“,金靴奖”字符串
      d(sht.Cells(intI, 3).Value) = _
              d(sht.Cells(intI, 3).Value) & ",金靴奖"
    Else
      '如果不存在，则添加新的键值对
      d.Add sht.Cells(intI, 3).Value, "金靴奖"
    End If
  Next

  '输出字典数据，第1列为球员名，第2列为对应奖项
  sht.Range("E1").Resize(d.Count, 1).Value = _
           Application.WorksheetFunction.Transpose(d.Keys)
  sht.Range("F1").Resize(d.Count, 1).Value = _
           Application.WorksheetFunction.Transpose(d.Items)
End Sub

import xlwings as xw  #导入xlwings包
#从constants类中导入Direction
from xlwings.constants import Direction
import os  #导入os包
#获取本py文件的当前路径
root = os.getcwd()
#创建Excel应用，可见，没有工作簿
app=xw.App(visible=True, add_book=False)
#打开数据文件，可写
bk=app.books.open(fullname=root+\
    r'\球员奖项汇总.xlsx',read_only=False)
sht=bk.sheets(1)  #获取第1个工作表
#工作表中第1列数据最大行号
row_num_1=sht.api.Range('A1').End(Direction.xlDown).Row
#工作表中第2列数据最大行号
row_num_2=sht.api.Range('B1').End(Direction.xlDown).Row
#工作表中第3列数据最大行号
row_num_3=sht.api.Range('C1').End(Direction.xlDown).Row
d={}
#第1列数据添加进字典，球员名为键，奖项为值
for i in range(2,row_num_1):
    d[sht.cells(i,1).value]='金球奖'
#第2列数据添加进字典
for i in range(2,row_num_2):
    #如果球员名已经存在，追加奖项；否则添加键值对
    if sht.cells(i,2).value in d:
        d[sht.cells(i,2).value]=d[sht.cells(i,2).value]+',最佳球员'
    else:
        d[sht.cells(i,2).value]='最佳球员'
#第3列数据添加进字典
for i in range(2,row_num_3):
    #如果球员名已经存在，追加奖项；否则添加键值对
    if sht.cells(i,3).value in d:
        d[sht.cells(i,3).value]=d[sht.cells(i,3).value]+',金靴奖'
    else:
        d[sht.cells(i,3).value]='金靴奖'
#输出字典数据
sht.range('E1').options(transpose=True).value=list(d.keys())
sht.range('F1').options(transpose=True).value=list(d.values())

Sub Test()
  Dim intI As Integer
  Dim d1 As Dictionary  '字典对象，处理子课题名称
  Set d1 = New Dictionary
  Dim d2 As Dictionary  '字典对象，处理子课题个数
  Set d2 = New Dictionary
  Dim sht As Object
  Set sht = ActiveSheet
  Dim intR As Integer
  Dim strD

  On Error Resume Next
  '获取原始数据
  intR = sht.Range("A1").End(xlDown).Row
  For intI = 2 To intR
    strD = sht.Cells(intI, 1).Value
    '如果当前数据作为字典的键已经存在，
    '追加新子课题名，个数加1
    If d1.Exists(strD) Then
      d1(strD) = d1(strD) & "|" & sht.Cells(intI, 2).Value
      d2(strD) = d2(strD) + 1
    Else  '如果不存在，添加键值对，个数为1
      d1.Add strD, sht.Cells(intI, 2).Value
      d2.Add strD, 1
    End If
  Next

  '输出课题名称
  sht.Range("D2").Resize(d1.Count, 1).Value = _
           Application.WorksheetFunction.Transpose(d1.Keys)
  '输出课题对应的子课题名称
  sht.Range("E2").Resize(d1.Count, 1).Value = _
           Application.WorksheetFunction.Transpose(d1.Items)
  '输出课题对应的子课题的个数
  sht.Range("F2").Resize(d1.Count, 1).Value = _
           Application.WorksheetFunction.Transpose(d2.Items)
End Sub

import xlwings as xw  #导入xlwings包
#从constants类中导入Direction
from xlwings.constants import Direction
import os  #导入os包
#获取本py文件的当前路径
root = os.getcwd()
#创建Excel应用，可见，没有工作簿
app=xw.App(visible=True, add_book=False)
#打开数据文件，可写
bk=app.books.open(fullname=root+\
    r'\研究课题的子课题汇总.xlsx',read_only=False)
sht=bk.sheets(1)  #获取第1个工作表
#工作表中第1列数据最大行号
row_num=sht.api.Range('A1').End(Direction.xlDown).Row
d1={}  #字典1，课题为键，子课题集合为值
d2={}  #字典2，课题为键，子课题个数为值
for i in range(2,row_num):
    it=sht.cells(i,1).value
    #如果当前数据作为字典的键已经存在，
    #追加新子课题名，个数加1
    if it in d1:
        d1[it]=d1[it]+'|'+sht.cells(i,2).value
        d2[it]=d2[it]+1
    else:  #如果不存在，在字典中添加新的键值对
        d1[it]=sht.cells(i,2).value
        d2[it]=1
#输出课题名称
sht.range('D2').options(transpose=True).value=list(d1.keys())
#输出课题对应的子课题名称
sht.range('E2').options(transpose=True).value=list(d1.values())
#输出课题对应的子课题的个数
sht.range('F2').options(transpose=True).value=list(d2.values())