Question

在这段代码中，我希望它检查列“B”是否有重复项 - 如果是，我应该删除右侧的Cell + 2单元格。

所以如果（B12）=（B13）它应该删除（B13），（B14），（B15）

duplicateremover位于代码的底部，无法正常工作。 B列应该有大约50个不同的数字，但它只能找到2。

Sub Expa()

Sheets("STUDYBOARD_ID Blank").Select
'For / Next unik liste
For i = 2 To 18288
If IsEmpty(Sheets("Base").Cells(i, 8)) = True Then
Worksheets("STUDYBOARD_ID Blank").Cells(i, 2) = Worksheets("Base").Cells(i, 2)
Worksheets("STUDYBOARD_ID Blank").Cells(i, 3) = Worksheets("Base").Cells(i, 9)
Worksheets("STUDYBOARD_ID Blank").Cells(i, 4) = Worksheets("Base").Cells(i, 10)
End If
Next i

'For / Next fuld liste
For i = 2 To 18288
If IsEmpty(Sheets("Base").Cells(i, 8)) = True Then
Worksheets("STUDYBOARD_ID Blank").Cells(i, 7) = Worksheets("Base").Cells(i, 2)
Worksheets("STUDYBOARD_ID Blank").Cells(i, 8) = Worksheets("Base").Cells(i, 9)
Worksheets("STUDYBOARD_ID Blank").Cells(i, 9) = Worksheets("Base").Cells(i, 10)
End If
Next i

'Overskrifter unik liste
Worksheets("STUDYBOARD_ID Blank").Cells(1, 2).Font.Bold = True
Cells(1, 2) = "Unik liste"
Cells(2, 2) = "PROGRAM_CODE"
Cells(2, 3) = "FACULTY_ID"
Cells(2, 4) = "PROGRAM_TYPE_LETTER"

'Overskrifter fuld liste
Worksheets("STUDYBOARD_ID Blank").Cells(1, 6).Font.Bold = True '
Cells(1, 6) = "Fuld liste"
Cells(2, 7) = "PROGRAM_CODE"
Cells(2, 8) = "FACULTY_ID"
Cells(2, 9) = "PROGRAM_TYPE_LETTER"

'Sorterer for overblik unik liste
ActiveWorkbook.Worksheets("STUDYBOARD_ID Blank").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("STUDYBOARD_ID Blank").Sort.SortFields.Add Key:=Range( _
"B2:B18288"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("STUDYBOARD_ID Blank").Sort
.SetRange Range("B2:E18288")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets("STUDYBOARD_ID Blank").Columns("A:F").AutoFit

'Sorterer for overblik fuld liste
ActiveWorkbook.Worksheets("STUDYBOARD_ID Blank").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("STUDYBOARD_ID Blank").Sort.SortFields.Add Key:=Range( _
"G2:G18288"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("STUDYBOARD_ID Blank").Sort
.SetRange Range("G2:J18288")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets("STUDYBOARD_ID Blank").Columns("F:J").AutoFit


Dim Information1 As Range
Dim Information2 As Long

Information2 = ActiveSheet.Range("B" & Rows.Count).End(xlUp).row
Set Information1 = ActiveSheet.Range("B1:D" & Information2)
Information1.RemoveDuplicates Columns:=3, Header:=xlYes



End Sub

Answer 1

如果B列是应该检查dublicates的人，那么代码应该如下所示：

Information1.RemoveDuplicates Columns:=2, Header:=xlYes

第3列是C。

删除重复的VBA失败

1 个答案: