4个回答
展开全部
这个用VBA比较方便,代码如下
Sub 二列多行()
[E1:F9999].ClearContents
Dim arr1, dic, x, arr2(1 To 10, 1 To 2), m%, k% '定义变量
Set dic = CreateObject("Scripting.dictionary") '后期绑定引用字典
arr1 = Range("A1").CurrentRegion '把单元区域装到数组arr1
For x = 2 To UBound(arr1, 1) '循环数组arr1的行
If dic.exists(arr1(x, 1)) Then '判断数组元素arr1(x,1)在字典关键词里是否存在,
m = dic(arr1(x, 1)) '如果存在,把关键词arr1(x,1)的条目读出来,在原来的
'基础上累加,通过读取关键词arr1(x,1)的条目,找到在数组arr2那一行上累加
arr2(m, 2) = arr2(m, 2) & ";" & arr1(x, 2) '在数组arr2第m行,第2列上累加
Else '如果关键词arr1(x,1)不存在,那么
k = k + 1 '计数
dic(arr1(x, 1)) = k '把数组arr1(x,1)装到字典dic里,条目装一个k,
'这个k的作用来给数组arr2中找到存放那一行
arr2(k, 1) = arr1(x, 1) '把数组arr1里的第x行第1列装到数组arr2的第k行,第1列
arr2(k, 2) = arr1(x, 2) '把数组arr1里的第x行第2列装到数组arr2的第k行,第2列
End If
Next x
Range("E1:F" & Rows.Count) = "" '清空区域,用来存放新的数据
[E1:F1] = Array("品类", "物品") '填充表头
[E2].Resize(k, 2) = arr2 '把数组arr2读到单元格区域
End Sub
Sub 二列多行()
[E1:F9999].ClearContents
Dim arr1, dic, x, arr2(1 To 10, 1 To 2), m%, k% '定义变量
Set dic = CreateObject("Scripting.dictionary") '后期绑定引用字典
arr1 = Range("A1").CurrentRegion '把单元区域装到数组arr1
For x = 2 To UBound(arr1, 1) '循环数组arr1的行
If dic.exists(arr1(x, 1)) Then '判断数组元素arr1(x,1)在字典关键词里是否存在,
m = dic(arr1(x, 1)) '如果存在,把关键词arr1(x,1)的条目读出来,在原来的
'基础上累加,通过读取关键词arr1(x,1)的条目,找到在数组arr2那一行上累加
arr2(m, 2) = arr2(m, 2) & ";" & arr1(x, 2) '在数组arr2第m行,第2列上累加
Else '如果关键词arr1(x,1)不存在,那么
k = k + 1 '计数
dic(arr1(x, 1)) = k '把数组arr1(x,1)装到字典dic里,条目装一个k,
'这个k的作用来给数组arr2中找到存放那一行
arr2(k, 1) = arr1(x, 1) '把数组arr1里的第x行第1列装到数组arr2的第k行,第1列
arr2(k, 2) = arr1(x, 2) '把数组arr1里的第x行第2列装到数组arr2的第k行,第2列
End If
Next x
Range("E1:F" & Rows.Count) = "" '清空区域,用来存放新的数据
[E1:F1] = Array("品类", "物品") '填充表头
[E2].Resize(k, 2) = arr2 '把数组arr2读到单元格区域
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
写代码可以处理,需要具体的数据和文档
追问
数据就是只有8行,这么简单的了。我不知道如何上传附件。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询