Question

我尝试制作一个程序，将重复项和输出分成其他工作表。数据由3列和数千行组成。第一列是唯一编号，第二列是材料名称，第三列是材料的描述。

我试过了：

Sub duplicates_separation()

    Dim duplicate(), i As Long
    Dim delrange As Range, cell As Long
    Dim delrange2 As Range

    Dim shtIn As Worksheet, shtOut As Worksheet
    Set shtIn = ThisWorkbook.Sheets("process")
    Set shtOut = ThisWorkbook.Sheets("output")

    x = 2
    y = 1

    Set delrange = Range("b1:b30000")  'set your range here
    Set delrange2 = Range("c1:c30000")

    For cell = 1 To delrange.Cells.Count
        If Application.CountIf(delrange, delrange(cell)) > 1 Then
            ReDim Preserve duplicate(i)
            duplicate(i) = delrange(cell).Address
            i = i + 1
        End If
    Next

    For i = UBound(duplicate) To LBound(duplicate) Step -1
        Range(duplicate(i)).Value = shtOut.Cells(x, 1).Value
        x = x + 1
    Next i

End Sub

但它转到了Error 9, Out of Range。以前工作过，我不知道为什么会出错。有谁知道为什么？

更新

错误发生在For i = UBound(duplicate) To LBound(duplicate) Step -1

我的意思是：从 range(duplicate(i)).entirerow.cut shtout.cells(x,1).paste

到

Range(duplicate(i)).Value = shtOut.Cells(x, 1).Value

更新现在可以使用了！

Sub duplicates_separation()

    Dim duplicate(), i As Long
    Dim delrange As Range, cell As Long
    Dim delrange2 As Range

Dim shtIn As Worksheet, shtOut As Worksheet
      Set shtIn = ThisWorkbook.Sheets("process")
    Set shtOut = ThisWorkbook.Sheets("output")

    x = 2
    y = 1

    Set delrange = shtIn.Range("b1:b30000")  'set your range here
   Set delrange2 = shtIn.Range("c1:c30000")

'search duplicates in 2nd column
    For cell = 1 To delrange.Cells.Count
        If Application.CountIf(delrange, delrange(cell)) > 1 Then
            ReDim Preserve duplicate(i)
            duplicate(i) = delrange(cell).Address
            i = i + 1
        End If
    Next
'search duplicates in 3rd column
    For cell = 1 To delrange2.Cells.Count
        If Application.CountIf(delrange2, delrange2(cell)) > 1 Then
            ReDim Preserve duplicate(i)
            duplicate(i) = delrange2(cell).Address
            i = i + 1
        End If
    Next
        'add header
    shtOut.Cells(1, 1).Resize(1, 3).Value = _
      Array("Material Number", "Short Description", "Long Description")

'print duplicates
    For i = UBound(duplicate) To LBound(duplicate) Step -1
    shtOut.Cells(x, 1).EntireRow.Value = shtIn.Range(duplicate(i)).EntireRow.Value
    x = x + 1
Next i



End Sub

Answer 1

如果在选择包含数据的工作表时运行代码，则此方法有效如果没有，并且当前选中的工作表在b1:b30000中没有值，则此行：

For i = UBound(duplicate) To LBound(duplicate) Step -1

将生成Error 9，因为您无法初始化duplicate变量，因为当Redim Preserve语句满足时，您只有If。

为避免错误，请正确声明变量delrange，如下所示：

Set delrange = shtIn.Range("b1:b30")  'i assumed only that shtIn is the source sheet, change otherwise.
Set delrange2 = shtIn.Range("c1:c30")

然后更改此行：

For i = UBound(duplicate) To LBound(duplicate) Step -1
    shtOut.Cells(x, 1).Value = shtIn.Range(duplicate(i)).Value
    x = x + 1
Next i

同样，我假设您正在shtOut上写，而不是像在代码中所做的那样。

单独重复并输出到其他工作表

1 个答案: