自动列表的问题总是选择和粘贴数组的第一行

Posted 2023-03-27

【中文标题】自动列表的问题总是选择和粘贴数组的第一行

【英文标题】：Problems with an automated list always selecting and pasting the first line of the array

【发布时间】：2015-12-08 22:10:35

【问题描述】：

更新：

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

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

“完整列表”的第一行（在本例中为 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://***.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| | | | | | | | | | | |""

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

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

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

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

任何帮助将不胜感激:)

【问题讨论】：

我已经为此苦苦挣扎了很长时间

您尝试过什么？您对您未尝试过的可能/可能工作有什么想法？

您可以使用高级过滤器来做到这一点。不需要 vba。

我试过这个。它可以工作，但非常麻烦，并且仍然有在发送前需要删除的代码。当我不在时，其他人也可以使用它。

您不需要任何代码来使用高级过滤器，但您确实需要一些知识，而且它不是最直观的。

【参考方案1】：

有几种方法可以做到这一点，但其中一种方法是使用AutoFilter。假设两个工作表都存在。我根据您提供的其他详细信息进行了一些修改，并根据答案here 实现了自定义函数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://***.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

【讨论】：

尝试运行此宏时出现错误 424。显然 ws.AutoFilter = False

行有错误

@user5656417 我对我的答案进行了修改，我认为它应该是wsFull.AutoFilterMode = False（ws 不是一个有效的对象，即使它是，我原来的答案有错误的方法姓名）。尝试一下，看看它是如何工作的。

好吧，差不多就是这样！我不确定如何从每个正确的行中仅复制这三个单元格 C、D 和 P。它还需要从第 9 行开始，目前它从开头开始，并且由于某种未知原因，这些单元格和文本也被复制。非常感谢，每次我尝试我的代码都比这长得多，不幸的是从来没有工作过。

抱歉，您正在寻找其他人来解决您的所有问题并免费提供交钥匙代码。这真的不是这个网站的精神，如果我为你这样做，我不会真正帮助任何人。祝你好运。

第一次使用这个网站很抱歉。如果我遇到一个忘恩负义或有需要的人，我会道歉。我已经尝试了一段时间，并震惊了其他人提出解决方案的速度有多快，不确定代码如何从特定行开始或如何仅复制特定单元格。我了解您是否不愿将所有内容都拼写出来。您还有其他资源可以指点我吗？谢谢:)