需要根据另一个工作sheet中的值用连续的行数据填充一个sheet

Need to fill a sheet with consecutive rows data based on value in another worksheet

好的,情况是这样的。我创建了一个包含 5 sheet 的工作簿。

第一个 sheet 包含 QTY、DESCRIPTION、PRICE 和一些其他数据的列,但这些是相关的。

根据输入的数据,填写了一张人工发票和几张订单。那工作正常。

我遇到的问题是我还需要它来填写一份 sheet 命名合同。主 sheet 上大约有 75 个项目,但合同永远不会超过 30 个项目。

我只需要将主 sheet 上 QTY 的非零值连续拉到合同 sheet 中,这样在数据出现之前没有空白行- set 用完了主要 sheet 上数量非零的项目。

I.E. 如果主 sheet 上有 15 行非连续的 QTY 值非零,在合同 sheet 中我需要前 15 行30 从具有非零 QTY 值的主要工作 sheet 行提取 QTY、DESCRIPTION、PRICE。

我希望我是有道理的..这让我很困惑!

谢谢

编辑:我刚刚意识到,我只需要将 QTY 和 Contract Cost 具有非零值的数据提取到合同 sheet!糟糕!

考虑以下屏幕截图。左边是"Main"sheet,右边是"Contract"sheet.

"Contract" sheet 上的单元格 A2 具有公式

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

这是数组公式,必须用Ctrl+Shift+Enter确认.然后向下复制。

调整单元格引用以反映您的情况。使用带行号的范围。不要对数组公式使用整列引用。

编辑:return 只有在现有条件之外成本大于 0 的行,使用此公式,也使用 Ctrl-Shift-Enter 进行数组输入。

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

不确定这是否正是您要查找的内容,但如果您想在宏中执行此操作,我相信这样的方法可行:

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

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

试试这个。我假设您需要将数据从 main 拉到 contract。我希望我能回答你的问题
主工作表:

合同工作表(结果)

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