从具有条件的另一个工作簿中提取数据

Question

我正在尝试将数据从workbook1提取到workbook2，它满足workbook1中的某些条件。以下是我的代码。

Sub Button1_Click()
Dim iLast As Long
Dim i As Long, j As Long
Dim targetlastrow As Long, sourcelstrow As Long
Dim Sourcelastcol As Long
Dim source As Worksheet
Dim target As Worksheet
Dim InputRng As Range
Dim OutRng As Range
Dim xCol As Integer

Set source = Workbooks("workbook1").Sheets(1)
Set target = Workbooks("workbook2").Sheets("Sheet1")
xRow = 10
Set InputRng = source.Range("F2:F" & 41)
Set InputRng = InputRng.Columns(1)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)

xCol = InputRng.Cells.Count / xRow
ReDim xArr(1 To xRow, 1 To xCol + 1)
    For i = 0 To InputRng.Cells.Count - 1
        xValue = InputRng.Cells(i + 1)
        iRow = i Mod xRow
        iCol = VBA.Int(i / xRow)
        xArr(iRow + 1, iCol + 1) = xValue
    Next
    OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
End Sub

这是示例输出工作簿2

来自workbook1的示例数据

目前我设法从工作簿1中取出所有前40个数据：F列。但是我试图仅通过PASS条件拉出前40个数据。请参阅Workbook1 C列。

请帮忙。我是新用的这个vba。

Answer 1

尝试使用以下代码。

Sub Button1_Click()
Dim iLast As Long
Dim i As Long, j As Long, k As Long
Dim targetlastrow As Long, sourcelstrow As Long
Dim Sourcelastcol As Long
Dim source As Worksheet
Dim target As Worksheet
Dim InputRng As Range
Dim OutRng As Range
Dim ConRng As Range
Dim xCol As Integer

Set source = Workbooks("workbook1").Sheets(1)
Set target = Workbooks("workbook2").Sheets("Sheet1")
xRow = 10
Set InputRng = source.Range("F2:F" & 41)
Set InputRng = InputRng.Columns(1)
Set ConRng = source.Range("C2:C" & 41)
Set ConRng = ConRng.Columns(1)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
k = 0
xCol = InputRng.Cells.Count / xRow
ReDim xArr(1 To xRow, 1 To xCol + 1)
    For i = 0 To InputRng.Cells.Count - 1
        xValue = InputRng.Cells(i + 1)
        xCon = ConRng.Cells(i + 1)
        If xCon = "PASS" Then
            iRow = k Mod xRow
            iCol = VBA.Int(k / xRow)
            xArr(iRow + 1, iCol + 1) = xValue
        Else
            k = k - 1
        End If
        k = k + 1
    Next
    OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
End Sub