数组VBA代码(数据提取)

时间:2014-12-16 15:58:11

标签: arrays excel vba extraction

当前; y正在根据用户表单中的条件提取数据(行),但下面的代码只适用于单个工作表一旦工作表上的按钮可用,我可以使用下面的代码工作并写入正如预期的那样,“奴隶”表,但我不能为我的生活得到正确的数组编译代码。

我尝试过不同地方的不同代码,包括这里,但我没有足够的能力来调试故障。

有人可以帮助我,或指出我正确的方向吗?

Sub CommandButton1_Click()
    Dim strsearch As String, lastline As Integer, tocopy As Integer    
    strsearch = CStr(InputBox("enter the string to search for"))

        'Enter code for all sheets in here...

    lastline = Range("A65536").End(xlUp).Row
    j = 1

    For i = 1 To lastline
        For Each c In Range("A" & i & ":Z" & i)
            If InStr(c.Text, strsearch) Then
                tocopy = 1
            End If
        Next c
        If tocopy = 1 Then
            Rows(i).Copy Destination:=Sheets("Slave").Rows(j)
            j = j + 1
        End If
    tocopy = 0
    Next i
End Sub

1 个答案:

答案 0 :(得分:1)

有更快的方法可以做到这一点,但这只是在表单循环中添加

Sub CommandButton1_Click()
    Dim strsearch As String, lastline As Long 
    Dim sht as WorkSheet

    strsearch = CStr(InputBox("enter the string to search for"))
    j = 1

    For Each sht in ThisWorkbook.WorkSheets
    If sht.Name <> "Slave" Then

    lastline = sht.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To lastline
        For Each c In sht.Range("A" & i & ":Z" & i)
            If InStr(c.Text, strsearch) Then
                sht.Rows(i).Copy Destination:=Sheets("Slave").Rows(j)
                j = j + 1
                Exit For 'stop looking!
            End If
        Next c
    Next i

    End If
    Next sht

End Sub
相关问题