我需要计算行的实例并根据多个列值删除重复项

Question

BASE TABLE

成品

所以我正在努力将CSV导出分类为一种格式，允许我和我所在部门的人员快速将信息复制并粘贴到已经存在的工作簿中。现有工作簿运行有几个公式和代码，因此我不能使用CSV导出自动执行的格式创建新工作簿。基本上我需要获取多行信息，这些信息具有多列标识符，并对这些行进行计数/求和并除去重复项，但我需要该行在其中的列中包含所有相应的信息。我已经尝试了标准的excel公式，我可以获得子总计或删除和总和，但它不会将其余的信息带入其中。

所以最后的信息顺序是检查匹配的副本是否为SKU，Floor Lvl，Detail，Room，Lable

感谢您提供任何帮助！

Answer 1

正如@teylyn建议的那样，Pivot Table是可行的方法：

选择包含标题的数据

Insert > Pivot Table

在“行标签”框中，按“标签”排列所有字段，然后选择“样式”，然后选择“SKU”...“计数”除外

删除“值”框中的“计数”字段，并将其设置为“计数总和”

PivotTable Tools > Design > Report Layout > Show in Tabular Form

PivotTable Tools > Design > Report Layout > Repeat All Item Labels

PivotTable Tools > Design > Grand Totals > Off for Rows and Columns

PivotTable Tools > Design > Subtotals > Do Not Show Subtotals

我得到与“成品”相同的结果。

Answer 2

根据现有的评论/答案，数据透视表可能是最佳选择。但也许下面也适合你（假设它有效）。您需要指定PathToCSV。

Option explicit

Sub GroupCSVbyColumns()

Dim PathToCSV as string
PathToCSV = "C:\New Folder\ff.csv" 'Replace with actual path.'

If len(dir(PathToCSV)) >0 then

Dim ContentsOfCSV as string

Open PathToCSV for binary access read as #1
ContentsOfCSV = space$(lof(1))
Get #1,1, ContentsOfCSV ' Assumes file will fit in memory'
Close #1

Dim RowsInCSV() as string
RowsInCSV = split(ContentsOfCSV, vbNewline, -1, vbbinarycompare) ' Assumes rows are separated by new line character'

Const COMMA_DELIMITER as string = ","
Dim RowIndex as long

Dim OutputList() as string
Dim OutputCounts() as long

Redim OutputList(lbound(RowsInCSV) to ubound(RowsInCSV))

Redim OutputCounts(lbound(RowsInCSV) to ubound(RowsInCSV))

' "So final order of info to check if matched duplicates would be SKU, Floor Lvl, Detail, Room, Lable"
Not sure if it makes a difference in your case, but code below considers every column (apart from ' Count') when determining duplicates -- not just the ones you mentioned.'

Dim MatchResult as variant
Dim MatchesCount as long: MatchesCount = lbound(OutputList) 'this assignment ensures we leave the first element blank and reserved for header row, as we increment MatchCount first.
Dim CurrentRowText as string
Dim CurrentRowCount as long

For RowIndex = (lbound(RowsInCSV)+1) to ubound(RowsInCSV) ' Skip row of headers'

If len(RowsInCSV(RowIndex))>0 then

CurrentRowText = left$(RowsInCSV(RowIndex),instrrev(RowsInCSV(RowIndex),comma_delimiter,-1, vbbinarycompare)-1)

CurrentRowCount = clng(mid$(RowsInCSV(RowIndex),1+instrrev(RowsInCSV(RowIndex),comma_delimiter,-1, vbbinarycompare)))

' Filter function might perform better than Match below. '
MatchResult = application.match(CurrentRowText, OutputList,0)

If isnumeric(MatchResult) then
OutputCounts(clng(MatchResult)) = OutputCounts(clng(MatchResult)) + CurrentRowCount

Else
MatchesCount = MatchesCount + 1
OutputList(MatchesCount) = CurrentRowText
OutputCounts(MatchesCount) = OutputCounts(MatchesCount) + CurrentRowCount

End if

End if

Next RowIndex

Dim TemporaryArray() as string
Dim ColumnIndex as long

TemporaryArray = split(RowsInCSV(lbound(RowsInCSV)),comma_delimiter,-1, vbbinarycompare)

Dim OutputTable(1 to (MatchesCount+1), 1 to (ubound(TemporaryArray)+1))

' Assign all headers from header row; done outside of loop below as all columns are looped through.'
For ColumnIndex = lbound(OutputTable,2) to (ubound(OutputTable,2))
OutputTable(1,ColumnIndex) = TemporaryArray(ColumnIndex-1)
Next ColumnIndex

For RowIndex = (lbound(OutputTable,1)+1) to ubound(OutputTable,1)

TemporaryArray = split(OutputList(rowindex-1),comma_delimiter,-1, vbbinarycompare)

For ColumnIndex = lbound(OutputTable,2) to (ubound(OutputTable,2)-1)

OutputTable(RowIndex,ColumnIndex) = TemporaryArray(ColumnIndex-1)

Next ColumnIndex

OutputTable(RowIndex,ColumnIndex) = OutputCounts(RowIndex-1)

Next RowIndex

Dim OutputSheet as worksheet
Set OutputSheet = Thisworkbook.worksheets.add
 OutputSheet.range("A1").resize(ubound(OutputTable,1),ubound(OutputTable,2)).value2 = OutputTable

Else
Msgbox("No file found at " & PathToCSV)
End if

End sub

未经测试，写在手机上。