以下代码也有效

Question

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

请找到以下代码：

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

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

布局：

Answer 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

Answer 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

如何使用Excel宏从列中提取值到另一个工作表

2 个答案:

以下代码也有效