代码之家 › 专栏 › 技术社区 › burger

搜索值更改的范围,如果找到,复制整行

criteria search excel vba

burger · 技术社区 · 7 年前

我对VBA非常陌生(~4天新),我尝试用我通常的方法来解决这个问题,通过阅读大量关于这类资源的不同文章并进行实验,但还没有完全掌握它的窍门。我希望你们愿意指出我在这方面的错误。我已经看了很多(所有?)这些线程都有类似的问题,但我还不能从中为自己拼凑出一个解决方案。我希望你能原谅这一点,如果它已经在其他地方得到了回答。

背景:

我有一个电子表格,其中第5-713行中的项目向下列B(合并到单元格J),其中每个日期(列K-SP)的项目得分为1或0。我的目标是在工作表底部创建一个列表,其中包含从1到0的所有项目。首先,我尝试使用“生成列表”按钮将所有行中的0复制到底部,我想我以后会调整它来做我想做的事。我试过几种方法,但都有不同的错误。

Worksheet Sample 来看看我在说什么。

我经历了几次不同的尝试,每次都取得了有限的成功,通常每次都会出现不同的错误。我遇到过“对象范围的方法”失败、“需要对象”、“类型不匹配”、“内存不足”以及其他一些问题。我肯定我只是没有掌握一些基本语法,这导致了一些问题。

这是最新的一批代码,给出了错误“类型不匹配”。我也尝试过将“todo”设置为字符串,但它只会弹出“objectrequired”

Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim y As Integer, z As Integer, todo As Range

Set todo = ThisWorkbook.ActiveSheet.Range(Cells(5, 2), Cells(713, 510))

y = 5
z = 714
With todo
    Do
        If todo.Rows(y).Value = 0 Then
        todo.Copy Range(Cells(z, 2))
        y = y + 1
        z = z + 1
        End If
    Loop Until y = 708
End With


Application.ScreenUpdating = True
End Sub

另一个我认为有希望的尝试是下面的,但它让我“记忆不足”。

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim y As Integer, z As Integer

y = 5
z = 714

Do
    If Range("By:SPy").Value = 0 Then
    Range("By:SPy").Copy Range("Bz")
    y = y + 1
    z = z + 1
    End If
Loop Until y = 708

Application.ScreenUpdating = True
End Sub

如果您能帮助我们找到第一步,甚至是如何让它扫描从1变为0,我们将不胜感激。我肯定我错过了一些简单的东西,希望你们能原谅我的无知。

谢谢

1 回复 | 直到 7 年前

PartyHatPanda 7 年前

这将查看数据并将其复制到数据的最后一行下方。假设数据下面没有任何东西。它也只查找零之后它找到1。

Sub findValueChange()

    Dim lastRow As Long, copyRow As Long, lastCol As Long
    Dim myCell As Range, myRange As Range, dataCell As Range, data As Range
    Dim hasOne As Boolean, switchToZero As Boolean
    Dim dataSht As Worksheet




    Set dataSht = Sheets("Sheet1") '<---- change for whatever your sheet name is

    'Get the last row and column of the sheet
    lastRow = dataSht.Cells(Rows.Count, 2).End(xlUp).row
    lastCol = dataSht.Cells(5, Columns.Count).End(xlToLeft).Column

    'Where we are copying the rows to (2 after last row initially)
    copyRow = lastRow + 2

    'Set the range of the items to loop through
    With dataSht
        Set myRange = .Range(.Cells(5, 2), .Cells(lastRow, 2))
    End With

    'start looping through the items
    For Each myCell In myRange
        hasOne = False 'This and the one following are just flags for logic
        switchToZero = False
        With dataSht
            'Get the range of the data (1's and/or 0's in the row we are looking at
            Set data = .Range(.Cells(myCell.row, 11), .Cells(myCell.row, lastCol))
        End With
        'loop through (from left to right) the binary data
        For Each dataCell In data
            'See if we have encountered a one yet
            If Not hasOne Then 'if not:
                If dataCell.Value = "1" Then
                    hasOne = True 'Yay! we found a 1!
                End If
            Else 'We already have a one, see if the new cell is 0
                If dataCell.Value = "0" Then 'if 0:
                    switchToZero = True 'Now we have a zero
                    Exit For 'No need to continue looking, we know we already changed
                End If
            End If
        Next dataCell 'move over to the next peice of data

        If switchToZero Then 'If we did find a switch to zero:
            'Copy and paste whole row down
            myCell.EntireRow.Copy
            dataSht.Cells(copyRow, 2).EntireRow.PasteSpecial xlPasteAll
            Application.CutCopyMode = False
            copyRow = copyRow + 1 'increment copy row to not overwrite
        End If

    Next myCell


    'housekeeping
    Set dataSht = Nothing
    Set myRange = Nothing
    Set myCell = Nothing
    Set data = Nothing
    Set dataCell = Nothing


End Sub