Question

我正在尝试编写一个代码，该代码开始在特定列（D）中查找，然后在另一列（B）中查找以查看该特定文本是否已被使用（在B中）。

如果正在使用它，则应复制在相应B列中找到的整行，并将其粘贴到开始查找的位置（D列中的那一行）上方。

在B列中完成整个搜索之后，如果存在匹配项，则应删除初始D行。很有可能是添加了多行，因为B列中有多个匹配项。

我当前的代码应该足以完成上述所有工作。但是，似乎在cell命令上有问题（请参见下文）。它表示存在以下错误：Rows(cellcheck).EntireRow.Copy

Sub run()

Dim rng As Range
Dim check As Range
Dim cell As Range
Dim cellcheck As Range
Dim Delyn As Long

Set rng = Range("D2:D2500")
Set check = Range("B2:B2500")

For Each cell In rng
    'Go through every cell in column D
    RT = cell.Row

    For Each cellcheck In check
        RC = cellcheck.Row
        'Go through every cell in column B

            If Cells(RC, "B").Value = Cells(RT, "D").Value Then
                'If the text in Column B is equal to Column D then do

                Rows(cellcheck).EntireRow.Copy
                'Copy the row which we found in column B
                Rows(cell + 1).Insert Shift:=xlDown
                'Paste it where we started in column D
                Cells(cell + 1, "B").Value = Cells(cell, "B")
                'Copy the name in column B of the initial cell into the new row
                Delyn = Delyn + 1
                'Add one to delete a row, so we know that we have to delete the row where we started this search
            End If
        Next cellcheck

    If Delyn > 0 Then
        'If we added new rows, we want to delete the reference row
        Rows(cell).Delete
        Delyn = 0
        'To avoid deletion for every row, we want to set this 0, until we find another reference in the B-column
    End If

Next cell

End Sub

任何帮助将不胜感激。我希望任何人都知道此代码中的问题。

因此，总结：它基本上应该遍历2列，并复制B和D列之间的所有匹配项，并在使用的D行上方复制相应的B行，然后更改B列名称并删除D行。

Answer 1

谢谢大家帮助我。

如果有人对类似的编码感兴趣，那么最终的解决方案如下：

Sub Run()

Dim rng As Range
Dim check As Range
Dim cell As Range
Dim cellcheck As Range
Dim Delyn As Long

Set rng = Range("D2:D2500")
Set check = Range("B2:B2500")

For Each cell In rng
    'Go through every cell in column D
    RT = cell.Row

    For Each cellcheck In check
        RC = cellcheck.Row
        'Go through every cell in column B

            If Cells(RC, "B").Value = Cells(RT, "D").Value Then
                'If the text in Column B is equal to Column D then do

                cellcheck.EntireRow.Copy
                'Copy the row which we found in column B
                Rows(RT + 1).Insert Shift:=xlDown
                'Paste it where we started in column D
                Cells(RT + 1, "B").Value = Cells(RT, "B")
                'Copy the name in column B of the initial cell into the new row
                Delyn = Delyn + 1
                'Add one to delete a row, so we know that we have to delete the row where we started this search
            End If
        Next cellcheck

    If Delyn > 0 Then
        'If we added new rows, we want to delete the reference row
        Rows(RT).Delete
        Delyn = 0
        'To avoid deletion for every row, we want to set this 0, until we find another reference in the B-column
    End If

Next cell

End Sub

问题是我打电话给行，然后选择整行（已选择）。另一个小问题是调用单元格值（使用命令单元格），而不是询问行号（使用RT或RC）。

如何根据单元格中的值复制行

1 个答案: