时间戳

首页 > 解决方案 > 如何根据单元格中的值复制行

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

问题描述

我正在尝试编写一个代码，该代码开始在特定列 (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列之间的所有匹配项，并将相应的B行复制到已使用的D行上方，然后更改B列名称并删除D行。

标签： excelvba

解决方案

谢谢大家帮助我。

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

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）。

推荐阅读