需要根据另一个工作表中的值填充具有连续行数据的工作表

Question

好的就是这种情况。我已经创建了一个包含5张工作簿的工作簿。

第一张表格包含QTY，DESCRIPTION，PRICE和其他一些数据，但这些是相关的。

根据输入的数据，填写劳务发票和多个订单。这是正常的。

我遇到的问题是我还需要填写一份名为Contract的表格。主表上约有75个项目，但合同永远不会超过30个项目。

我需要将主表上QTY非零值的行连续拉到合同表，以便在数据集用完非零QTY的项目之前没有空白行主要表格。

ProjectB如果主表上有15个非连续行，且QTY的值为非零，则在合同表上我需要前30行中的前15行来提取数量，描述，价格来自主要工作表行具有非零QTY值。

我希望我有意义......这让我感到难过！

谢谢

编辑：我刚刚意识到，我只需要将数量和合同成本非零值的数据提取到合同表中！糟糕！

Answer 1

请考虑以下屏幕截图。左边是＆＃34; Main＆＃34;表格，右边是＆＃34;合同＆＃34;片材。

＆＃34;合同＆＃34;上的单元格A2表格具有公式

=IFERROR(INDEX(Main!A:A,SMALL(IF(ISNUMBER(Main!$A$1:$A$10)*(Main!$A$1:$A$10>0),ROW(Main!$A$1:$A$10),""),ROW(A1))),"")

这是一个数组公式，必须使用 Ctrl + Shift + Enter 确认。然后向下复制。

调整单元格引用以反映您的方案。使用带行号的范围。不要将整列引用与数组公式一起使用。

编辑：仅返回除现有条件之外的成本大于0的行，使用此公式，也使用Ctrl-Shift-Enter输入数组。

=IFERROR(INDEX(Main!A:A,SMALL(IF(ISNUMBER(Main!$A$1:$A$10)*(Main!$A$1:$A$10>0)*(Main!$c$1:$c$10>0),ROW(Main!$A$1:$A$10),""),ROW(A1))),"")

Answer 2

不确定这是否正是您正在寻找的，但如果您想在宏中执行此操作，我相信这样的事情会起作用：

Sub test()
'
' test Macro
'

'
    Dim i As Integer
    Range("A:A").Select
    i = Application.WorksheetFunction.Count(Selection) + 1
    Sheets("Sheet2").Select
    Dim numZero As Integer
    numZero = 0
    Dim temp As Integer
    For j = 2 To i
        temp = Range("Sheet1!A" & j).Value
        If temp = 0 Then
            numZero = numZero + 1
        Else
            Range("A" & j - numZero).Select
            Selection.Formula = "=IF(Sheet1!A" & j & "<> 0, Sheet1!A" & j & ",FALSE)"
            Range("B" & j - numZero).Select
            Selection.Value = "=Sheet1!B" & j
            Range("C" & j - numZero).Select
            Selection.Value = "=Sheet1!C" & j
        End If
    Next j
End Sub

这不是最干净的宏观原因，我把它快速地放在一起，但它完成了工作，如果你的数据不是很大，应该足够快。

Answer 3

试试这个。我假设您需要从主要数据到合约数据。我希望我能回答你的问题 主要工作表：

合同工作表（结果）

Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyOutputWorksheet As Worksheet

Sub PullData()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("Main")
Set MyOutputWorksheet = MyWorkbook.Sheets("Contract")

    Dim myValue As Long
    Dim RowPointer As Long

    For RowPointer = 2 To MyWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
        If MyWorksheet.Range("A" & RowPointer).Value > 0 And MyWorksheet.Range("A" & RowPointer).Value <> "" Then
            If MyOutputWorksheet.Cells(Rows.Count, "B").End(xlUp).Row > 15 Then
                Exit Sub
            End If
            MyWorksheet.Range(("A" & RowPointer) & ":C" & RowPointer).Copy Destination:=MyOutputWorksheet.Range("A" & MyOutputWorksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1)
        End If
    Next RowPointer


End Sub