Question

我有一张excel表格，我从其他工作表中将数据从每个工作表中拉出来。我试图在我的任何列中找到任何重复项并删除所有重复项（例如：如果有三个代码12gb，我想留下一个12gb）。我希望这样，以便我可以计算（自动）有多少个唯一值，然后自动填充图表。我已经尝试了很多不同的公式来做到这一点，但我认为需要一个VBA代码，但是之前我从未使用过那个编码所以我不知道该怎么做。下面是我的excel表的三列示例:(我无法发布图片/ excel表格

12gb        sdf     vfg
22rg        tttyhg  dsf
dfg455      ggff    df
fgfg        fff     vcs
4redd       ccv     dfgh
56ff        66hg    66y
yygf        66y     56ff
66ygt       yggfg   12gb
ghhg        
            vfg

Answer 1

这是一个hackish宏，它依赖于特定的列和位置，所以我不是这个解决方案的忠实粉丝。

它是通过记录我做的手动任务生成的

添加一行来表示列的结尾
将第2列和第3列复制到第1列的末尾。
删除第a列
然后再次手动创建3列。根据添加的栏目注释的结尾。

Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("A12").Select
ActiveCell.FormulaR1C1 = "1----"
Range("B12").Select
ActiveCell.FormulaR1C1 = "2----"
Range("C12").Select
ActiveCell.FormulaR1C1 = "3----"
Range("B1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A13").Select
ActiveSheet.Paste
Range("B13").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Range("A13").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A25").Select
ActiveSheet.Paste
Columns("A:A").Select
ActiveSheet.Range("$A$1:$A$46").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A13:A22").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Range("A23").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Range("B13").Select

现在假设Row数据不相关。如果是......这将无效。当Excel删除重复项时。

Answer 2

你可以做这样的事情，虽然我确信有更优雅的方式。原则上我只是在检查数值是否已经在数组中之后将每个值放入数组中：

Sub del_values()
Dim last_row, last_col, size, y As Integer
Dim arr() As Variant

'finding the last row and last column and calculating the possible size of the array

last_row = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
last_col = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
size = last_row * last_col
y = 0

'adjusting the array-size    
ReDim arr(size)

For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(last_row, last_col))

'avoiding blank cells
If cell.Value > "" Then

'checking if value is already in the array - if not, add it to the array and increase y - if it is, clear the contents of the cell
If IsError(Application.Match(cell.Value, arr, 0)) Then
arr(y) = cell.Value
y = y + 1
Else
Cells(cell.Row, cell.Column).ClearContents
End If
End If
Next
End Sub

我不确定你想要对包含重复的单元格做什么，所以我只是清除了内容 - 你当然可以删除它们

Cells(cell.Row, cell.Column).delete

顺便提一下，如果你想直接使用它，y等于唯一值的数量。

删除单元格但不删除行

2 个答案: