使用VBA基于类似值对Excel行进行分组

时间:2012-09-20 19:06:14

标签: excel vba excel-vba

我有report.xlsx文件,其中包含来自其他2个excel工作簿的数据,这些工作簿基于某些唯一值进行合并。 Pool_RAM列的数据来自file1.xlsxPool_HDD列的数据来自file2.xlsx。该列都包含一些重复值。现在我想根据相似的值对行进行分组,并按照下面的说明进行格式化。

Report.xlsx Actual Data

enter image description here

我希望数据采用以下格式。

Expected Format

enter image description here

如果您需要任何其他信息,请与我们联系。

1 个答案:

答案 0 :(得分:0)

尝试使用此宏并根据需要进行调整:

Sub GroupMyData()
'Assuming the data source is in column F and G, from row 2 to 1000
'The result will be put in column K and L
'part1: filter to unique values, put in column J temporarily
    Range("F2:F1000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("J2" _
        ), Unique:=True

'part2: fill the data
    Range("K1") = Range("F1")
    Range("L1") = Range("G1")
    Range("J2").Select
    Range(Selection, Selection.End(xlDown)).Select
    n = Selection.Count
    Range("K2").Select
    ck = 2
    cl = 2
    For i = 1 To n
      txt = Range("J" & (i + 1))
      numf = WorksheetFunction.CountIf(Range("F2:F1000"), txt)
      For j = 1 To numf
        Range("K" & ck) = txt
        ck = ck + 1
      Next
      numg = WorksheetFunction.CountIf(Range("G2:G1000"), txt)
      For j = 1 To numg
        Range("L" & cl) = txt
        cl = cl + 1
      Next
      If (ck > cl) Then
        cl = ck
      Else
        ck = cl
      End If
      ck = ck + 1
      cl = cl + 1
    Next
'part 3: delete the temporary data
    Range("J2:J1000").Select
    Selection.ClearContents
    Range("K2").Select

End Sub