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

Question

我正在尝试将工作簿 1 中的数据提取到满足工作簿 1 的特定条件的工作簿 2 中。下面是我的代码。

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

来自工作簿 1 的示例数据

目前我设法从 workbook1:Column F 中提取所有前 40 个数据。但我正在尝试仅在 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

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

Pull data from another workbook with condition

vba

excel

pull