Question

求教EXCEL宏制作高手

这样的一个工作表，有16000+行。现在需要筛选出A列的重复项。将B列的日期和C列的数值依次录入到D列，E列……最后将A列中的重复项删除。仅保留唯一值。
例

要求B,D,F……的日期与C,E,F……的数值是对应表1切递增的……
跪求宏高手指教





提示该问答中所提及的号码未经验证，请注意甄别。

Answer 1

用字典法，效率高，代码见下。
PS：
1、原工作表名为“原数据”
2、对原数据按日期先排序
3、新建一工作表，用于存储新数据，表名“新数据”

宏代码：
Sub newdata()
Dim crr()

set d = CreateObject("scripting.dictionary")
arr = Sheets("原数据").UsedRange.Value

For i = 1 To UBound(arr, 1)
If d.exists(arr(i, 1)) Then
d(arr(i, 1)) = d(arr(i, 1)) & "|" & arr(i, 2) & "|" & arr(i, 3)
Else
d(arr(i, 1)) = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
End If
Next

arr = d.items
ReDim crr(UBound(arr), 0)

For i = 0 To UBound(arr)
brr = Split(arr(i), "|")
ReDim Preserve crr(UBound(arr), Application.WorksheetFunction.Max(UBound(brr), UBound(crr, 2)))

For j = 0 To UBound(brr)
crr(i, j) = brr(j)
Next
Next

Sheets("新数据").[a1].Resize(UBound(crr, 1) + 1, UBound(crr, 2) + 1) = crr

End Sub

Answer 2

D1=IF(COUNTIF($A$1:$A1,$A1)=1,INDEX($B:$B,SMALL(IF($A:$A=$A1,ROW($A:$A),4^8),COLUMN(B1)/2+1)),"")

E1=IF(COUNTIF($A$1:$A1,$A1)=1,INDEX($C:$C,SMALL(IF($A:$A=$A1,ROW($A:$A),4^8),COLUMN(B1)/2+1)),"")

复制上面公式，分别粘到D1,E1，然后按ctrl shift 回车，一定要三个键一起按不要直接回车

d1,e1输完上面两个数组公式后，同时选中这个个单元格，右拉，下拉即可

Answer 3

导入到Access中，用SQL语句轻松解决，联系我

Answer 4

这个问题我包了，联系281987289，给你解决