0

更新：

每次打开选项卡时，它都会自动生成订单列表。

据我所知，代码中有一个错误：

  1. “完整列表”上的第一行（在本例中为 C8:P8）总是被复制并插入到新数组中，无论那里有什么。

我让它复制了一个空白行，但粘贴到“订单”选项卡中应该只列出订单项目。我尝试粘贴除第一行之外的结果数组中的所有项目，但没有成功。哦，非常感谢@David-Zemens 在这方面提供的所有帮助。你知道你在做什么，它显示了:)

Private Sub Worksheet_Activate()
    Dim wsList As Worksheet, wsOrder As Worksheet
    Dim rng As Range

    Set wsList = Worksheets("Full List")
    Set wsOrder = Worksheets("Order")
    wsList.Unprotect

    'Clear Columns B, C, & D below row 3 in the Order sheet
    wsOrder.Range("B3:D" & Rows.Count).ClearContents

    'Set Range to include all columns from C to P starting with row 8
    Set rng = wsList.Range("C8:P" & GetLastRow(wsList, 3))
    wsList.AutoFilterMode = False

    'filter so that only numeric values in column P are showing
    rng.AutoFilter Field:=14, Criteria1:=">0", _
        Operator:=xlAnd

    'Copy column C (in wsList) to column B (in wsOrder)
    rng.Columns(1).SpecialCells(xlCellTypeVisible).Copy
    wsOrder.Range("B2").PasteSpecial xlPasteValues
    'Copy column D (in wsList) to column C (in wsOrder)
    rng.Columns(2).SpecialCells(xlCellTypeVisible).Copy
    wsOrder.Range("C2").PasteSpecial xlPasteValues
    'Copy column P (in wsList) to column D (in wsOrder)
    rng.Columns(14).SpecialCells(xlCellTypeVisible).Copy
    wsOrder.Range("D2").PasteSpecial xlPasteValues

    wsList.AutoFilterMode = False
    wsList.Protect

End Sub

Function GetLastRow(sh As Worksheet, column As Long)
'  Function will return the last effective cell in specified column on worksheet
'      sh:      Worskheet object i.e., Worksheets("Sheet1")
'      column:  long/integer value of column, i.e., column A = 1, column N = 12, etc.
'  Modified from :
'  http://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba
'
With sh
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastRow = .Cells.Find(What:="*", _
                      After:=.Cells(1, column), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastRow = 1
    End If
End With

GetLastRow = lastRow
End Function

原帖：

我希望有人可以提供帮助。

我创建了一个 Excel 程序，让我可以查看库存水平并将其与计数值或预期值进行比较。这让我可以看到我们需要订购多少商品。

我希望做的是（在另一个选项卡上）生成一个单独的列表，该列表只显示产品代码、产品名称和要订购的数量。

计算所有内容的主选项卡名为“完整列表”，即 Sheet06。

有多行，但我感兴趣的行从第 9 行开始，位于 C（产品代码）、D（产品名称）和 P（订购数量）列上，并且有超过一千行产品使用一些空白行来尝试使其易于阅读（如果需要，这些行可以用一些东西填充或使用 Q 列来获得 TRUE/FALSE "=ISNUMBER(P9)" 等式）

在 P 列，如果不需要订单，则有空格 (="") 或文本

  |A|B|Product Code|Name     |E|F|G|H|I|J|K|L|M|N|O|Order
9 | | |00002       |something| | | | | | | | | | | |""
10| | |345663      |something| | | | | | | | | | | |3
11| | |6534214     |something| | | | | | | | | | | |15
12| | |            |         | | | |(Blank row)| | | 
13| | |24435224    |something| | | | | | | | | | | |DONT ORDER
14| | |8784347     |something| | | | | | | | | | | |8
15| | |357823      |something| | | | | | | | | | | |""

我一直在尝试创建（但失败）的是另一个名为“订单”的选项卡，即 Sheet07

当且仅当另一个选项卡上的 P 行有数字时，它应该复制产品代码、名称和订购数量。此外，这必须复制为订单（18、4 等）生成的值，而不是公式（=E9-F9+G9....）。

 |A|Product Code|Name     |Order
4| |345663      |something|3
5| |6534214     |something|15
6| |8784347     |something|8

我已经为此苦苦挣扎了很长一段时间，并且遇到了心理障碍。

任何帮助，将不胜感激 ：）

4

1 回答 1

0

有几种方法可以做到这一点，但其中一种方法是使用AutoFilter. 假设两个工作表都存在。我根据您提供的其他详细信息进行了一些修改，并GetLastRow根据此处的答案实现了自定义功能。

这应该避免第二个错误，即复制一些额外的空白行。

Private Sub Worksheet_Activate()
    Dim wsFull As Worksheet, wsOrder As Worksheet
    Dim rng As Range

    Set wsFull = Worksheets("Full List")
    Set wsOrder = Worksheets("Order")

    'Clear Columns B, C, & D below row 3 in the Order sheet
    wsOrder.Range("B3:D" & Rows.Count).ClearContents

    'Set Range to include all columns from C to P starting with row 8
    Set rng = wsFull.Range("C8:P" & GetLastRow(wsFull, 3))
    wsFull.AutoFilterMode = False

    'filter so that only numeric values in column P are showing
    rng.AutoFilter Field:=14, Criteria1:=">0", _
        Operator:=xlAnd

    'Copy column C to column B
    rng.Columns(1).SpecialCells(xlCellTypeVisible).Copy
    wsOrder.Range("B2").PasteSpecial xlPasteValues
    'Copy column D to column C
    rng.Columns(2).SpecialCells(xlCellTypeVisible).Copy
    wsOrder.Range("C2").PasteSpecial xlPasteValues
    'Copy column P to column D
    rng.Columns(12).SpecialCells(xlCellTypeVisible).Copy
    wsOrder.Range("D2").PasteSpecial xlPasteValues

    wsFull.AutoFilterMode = False
End Sub`


Function GetLastRow(sh As Worksheet, column As Long)
'  Function will return the last effective cell in specified column on worksheet
'      sh:      Worskheet object i.e., Worksheets("Sheet1")
'      column:  long/integer value of column, i.e., column A = 1, column N = 12, etc.
'  Modified from :
'  https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba
'
With sh
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastRow = .Cells.Find(What:="*", _
                      After:=.Cells(1, column), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastRow = 1
    End If
End With

GetLastRow = lastRow
End Function
于 2015-12-08T22:25:13.640 回答