从另一个有条件的工作簿中提取数据
Pull data from another workbook with condition
我正在尝试将工作簿 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.
尝试使用以下代码。
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
我正在尝试将工作簿 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.
尝试使用以下代码。
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