【问题标题】：How to extract values from column using Excel macro into another sheet如何使用 Excel 宏从列中提取值到另一个工作表中
【发布时间】：2018-08-21 16:35:15
【问题描述】：

我想提取新工作表 (sheet2) 列中的所有“发票”值。现在我只能从 Invoice 中获取单个值（而不是获取所有值）。

请查看以下代码：

Sub MergeData()

a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a    
    If Worksheets("Sheet1").Cells(i, 4).Value = "Rechnungen / invoices" Then 

        Worksheets("Sheet1").Cells(i + 2, 4).Copy
        Worksheets("Sheet2").Activate
        b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sheet2").Cells(b + 1, 3).Select
        ActiveSheet.Paste
        Worksheets("Sheet1").Activate          
    End If
Next
End Sub

实际上我是宏的初学者，我不知道如何添加循环和条件来获取所有值。

布局：

【问题讨论】：

是合并单元格还是删除了网格线？
Rechnungen 会一直是 D25 吗？似乎不是您的代码。此外，您将如何确定何时停止在 D 和 E 列中查找发票编号？有什么东西可以用来确定何时停止？例如，单元格周围的一种边框？此外，发票能否继续跨越 F 列等？同样的问题，您如何确定发票何时停止跨列？右侧是否还有其他数据，或者您可以假设最后使用的列是发票必须停止的地方？还是有更好的办法？
您将如何确定何时停止查看发票编号的行？
我还会在 D 列上使用 Range.Find 方法来定位带有“Rechnungen / invoices”的单元格。
1. Rechnungen 会一直是 D25 吗？ ---> 不。它会在 D 列/行中有所不同。 2]您将如何确定何时停止沿着 D 和 E 列寻找发票号码？---> 我不知道。但是如果我们应用任何条件，那么它是可能的（不确定）。 3]此外，发票能否继续跨列 F 等？----> 它从 D 到 F。 4]右侧是否有其他数据，或者您可以假设最后使用的列是发票必须停止的地方？- -> 是的。 F 将是最后一个。

标签： vba excel

【解决方案1】：

这是一种循环方式。我通过找到文本的位置来定义行边界。

最小行限制：

发票将在包含"Rechnungen / invoices"的单元格之后

Set startCell = .Columns("D").Find("Rechnungen / invoices")

最大行限制：

发票将在包含"Anzahl/ Quantity"的单元格之前停止

Set endCell = .Columns("D").Find("Anzahl/ Quantity")

从左到右的约束：

已知发票位于 D 列和 F 列之间。

只有以下值的单元格：

.SpecialCells(xlCellTypeConstants)

Option Explicit
Public Sub Test()
    Application.ScreenUpdating = False
    Dim invoices As Object, currentCell As Range, startCell As Range, endCell As Range, loopRange As Range
    Set invoices = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Sheet1")
        Set startCell = .Columns("D").Find("Rechnungen / invoices")
        Set endCell = .Columns("D").Find("Anzahl/ Quantity")
        If startCell Is Nothing Or endCell Is Nothing Then Exit Sub
        If startCell.Row > endCell.Row Then Exit Sub
        Set loopRange = .Range("D" & startCell.Row + 1 & ":F" & endCell.Row - 1)
        If Application.WorksheetFunction.CountA(loopRange) = 0 Then Exit Sub
        For Each currentCell In loopRange.SpecialCells(xlCellTypeConstants)
            If Not invoices.exists(currentCell.Value) Then invoices.Add currentCell.Value, 1
        Next currentCell

        ThisWorkbook.Worksheets("Sheet2").Range("A1").Resize(invoices.Count, 1) = Application.WorksheetFunction.Transpose(invoices.keys)
    End With
    Application.ScreenUpdating = True
End Sub

【讨论】：

是的。位置每次都会有所不同，但格式会相同。我使用宏只从发票中获得了第一个值。
没有。 “Rechnungen / invoices”始终位于 D 列。但是发票的值在 D 、 E 和 F 列中
对不起。但是我在运行此代码时遇到错误。（错误：对象变量或未设置块变量）
" 如果 startCell 为 Nothing 或 endCell 为 Nothing 或 startCell.Row > endCell.Row 则退出 Sub"
我已编辑，但您需要检查是否找到正在搜索的文本。使用 F8 单步执行，查看是否设置了 startCell 和 endCell 表示找到文本。

【解决方案2】：

下面的代码也可以工作

Sub MergeData()
a = Worksheets("Tabelle1").Cells(Rows.count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Tabelle1").Cells(i, 4).Value = "Rechnungen / invoices" Then
        c = 0
        For k = 4 To 6
            For J = 2 To 6
                If (IsNumeric(Worksheets("Tabelle1").Cells(i + J, k))) Then
                    Worksheets("Tabelle1").Cells(i + J, k).Copy
                    Worksheets("Tabelle2").Activate
                    b = Worksheets("Tabelle2").Cells(Rows.count, 1).End(xlUp).Row
                    Worksheets("Tabelle2").Cells(b + c, 3).Select
                    c = c + 1
                    ActiveSheet.Paste
                    Worksheets("Tabelle1").Activate
                End If
            Next
        Next
    End If
Next

End Sub

【讨论】：