0

我在 B1 列中有日期和时间，在 D1 列中有金额。

我需要一个宏来搜索我的工作表中是否有指定的数量，如果找到副本数量以及下一张工作表的日期。多次发生。

如果包含搜索框会更好。

谢谢

这是我从互联网上发现的代码可以正常工作，但在这里它搜索“邮箱”一词，并且没有可用的搜索框。子 SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

    'If value in column E = "Mail Box", copy entire row to Sheet2
    If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

        'Select row in Sheet1 to copy
        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy

        'Paste row into Sheet2 in next row
        Sheets("Sheet2").Select
        Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
        ActiveSheet.Paste

        'Move counter to next row
        LCopyToRow = LCopyToRow + 1

        'Go back to Sheet1 to continue searching
        Sheets("Sheet1").Select

    End If

    LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute: MsgBox "发生错误。"

结束子

4

1 回答 1

0

以下是您可以调整的内容：

Sub dural()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim K As Long, N As Long, i As Long
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    K = 1
    s1.Select
    N = Cells(Rows.Count, "B").End(xlUp).Row
    v = Application.InputBox(Prompt:="Enter value", Type:=1)
    For i = 1 To N
        If Cells(i, "D").Value = v Then
            Cells(i, "B").Copy s2.Cells(K, "B")
            Cells(i, "D").Copy s2.Cells(K, "D")
        K = K + 1
        End If
    Next i
End Sub
于 2013-10-01T13:12:05.203 回答