Question

我正在尝试创建一个将在列中找到值的宏，如果满足条件，则将整行复制到另一个工作表。到目前为止，我失败了。

我有一张名为“DB”的工作表，其中所有原始数据都带有标题，范围从A到BG。具有满足条件值的列是“AJ”，它从无数据（AJ上的空白单元格）到数字10。

我还有其他三张将数据复制到的表格。 “BlankResults”，“0to8”和“9to10”（它们都与“DB”具有相同的标题）

我需要的是宏检查“DB”列“AJ”以获取以下内容：

>= 9 then copy the entire row and paste it on the sheet "9to10" 
<= 8 then copy and paste the row on "0to8" 
Blank Cells under AJ and copy the row to "BlankResults".

我知道空白单元格部分可能有点棘手，因为最后一行下方的单元格数量为空，而AJ上的空白单元格可以是AJ上的任何位置，但就像FYI一样，整个行从“A到BG”即使AJ上的单元格为空，也会有数据。

我打算粘贴我正在运行的代码，但它没有价值，因为它只搜索“＆gt; = 9”条件并复制行但我无法弄清楚如何在一个宏中完成所有操作，以及如何解决AJ上的空白单元格，因为我仍需要另一张纸上的行。

我正在尝试自动化我需要加载到数据透视表的报表，并且我想对所需的数据进行排序，因为我必须根据上面提到的标准进行大量计算。

如果您需要我提供更多信息，我很乐意这样做。

Answer 1

这样的事情应该有效，根据需要改变：

Sub test()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim k As Integer
i = 1
j = 1
k = 1

Dim DB As Worksheet
Dim zeroeight As Worksheet
Dim nineten As Worksheet
Dim blnk As Worksheet

Dim c As Range

For Each c In DB.Range("AJ:AJ")
     If c = "" Then
        If c.Offset(-1) <> "" Then
            c.EntireRow.Cut blnk.Cells(i, 1)
            i = i + 1
        Else: goto label
        End If

     ElseIf c > 8 Then
        c.EntireRow.Cut nineten.Cells(j, 1)
        j = j + 1

     ElseIf c > 1 Then
        c.EntireRow.Cut zeroeight.Cells(k, 1)
        k = k + 1
     End If

Next
Application.ScreenUpdating = True
label:
End Sub

查找符合条件的列和将行复制到另一个工作表

1 个答案: