vba 根据列中的重复值对excel中的值进行分组
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18060378/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Group Values in excel according duplicate value in column
提问by Suresh Jambhalkar
Suppose, I have Data
假设，我有数据
Column1 Column2 1 1000 1 -2000 1 3000 2 2000 2 -1000 3 5000 3 -4000
I want to display it like
我想像这样显示它
Column1 Column2 Column3 1 1000 3000 2 2000 3 5000
I want to take only positive value from column2 where column1 have same value(e.g. for 1 have 2 positive values. I want to display them in format shown above.)
我只想从 column2 取正值，其中 column1 具有相同的值（例如，1 有 2 个正值。我想以上面显示的格式显示它们。）
How can I achieve this using Manual Methods(Formulas) or using VBA?? I have written a code where it takes positive values from column1 where column1.value=1. But how to iterate through next values(i.e. 2 and 3)
如何使用手动方法（公式）或使用 VBA 来实现这一点？我写了一个代码，它从 column1 中取正值，其中 column1.value=1。但是如何遍历下一个值（即 2 和 3）
Sheets("Sheet1").Select
myvalue = Cells(2, 1).Value
MsgBox myvalue
Dim negativevalue(0 To 10) As Long
Dim colum As Integer
Dim row As Integer
colum = 1
row = 2
i = 0
While Cells(row, colum).Value = myvalue
If (Cells(row, 2).Value < 0) Then
MsgBox Cells(row, 2).Value
negativevalue(i) = Cells(row, 2).Value
End If
回答by neizan
There might be shorter ways, but this works. Select the desired range and run the following macro:
可能有更短的方法，但这是有效的。选择所需的范围并运行以下宏：
Sub ProcessData()
'Sort the data
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Selection.Cells(1, 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Selection
.Header = xlNo
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Process data
Dim cl As Object, r As Integer, c As Integer, cNum As Integer, cSt As Integer
Dim first As Boolean, update As Boolean
r = Selection.Cells(1, 1).Row - 1
cNum = Selection.Cells(1, 2).Column + 2
cSt = cNum + 1
first = True
update = False
For Each cl In Selection.Cells.Columns(1).Cells
If cl.Offset(0, 1).Value >= 0 Then
update = False
If first Then
first = False
update = True
ElseIf cl.Value <> Cells(r, cNum).Value Then
update = True
End If
If update Then
r = r + 1
c = cSt
Cells(r, cNum).Value = cl.Value
End If
Cells(r, c).Value = cl.Offset(0, 1).Value
c = c + 1
End If
Next
End Sub
回答by chuff
Here is a pure formula-based approach to your question.
这是针对您的问题的纯粹基于公式的方法。
Two sets of formulas are needed, the first set to create an unduplicated list of distinct values from column 1 and the second set to look up and place the positive values in column 2.
需要两组公式，第一组用于创建来自第 1 列的不同值的不重复列表，第二组用于查找并将正值放置在第 2 列中。
The formula to create the list of distinct column 1 values is placed in cell D2 and copied down the column. The formula uses a named range for the column 1 values. If you put it in another column, adjust the $D1$D:D1to the column you are using, and make sure it refers to the cell just above where you put the formula. For example, if you put the formula in cell C4, the column reference in the formula should be $C$3:C3
创建不同列 1 值列表的公式放置在单元格 D2 中并复制到列中。该公式对第 1 列的值使用命名范围。如果你把它放在另一列，调整$D1$D:D1到你正在使用的列，并确保它指的是你放置公式的正上方的单元格。例如，如果您将公式放在单元格中C4，则公式中的列引用应为$C$3:C3
Formula to create list of distinct values from column 1
Cell D2 =IFERROR(INDEX(Column1,MATCH(0,INDEX(COUNTIF($D:D1,Column1),
0,0),0)),"-")
The column 2 lookup is an array formula; in the example worksheet, it is entered in cell E2 (using the Ctrl-Shift-Enterkey combination) and then copied down and across.
第 2 列查找是一个数组公式；在示例工作表中，它是在单元格 E2 中输入的（使用Ctrl- Shift-Enter组合键），然后向下和横向复制。
Array Formula to lookup and place column 2 values
Cell E2 =IFERROR(INDEX(Column2,1/LARGE(IFERROR(1/((Column1=$D2)*
(Column2>=0)*ROW(INDIRECT("1:"&COUNTA(Column2)))),0),
COLUMNS($E:E)),1),"-")
