将多张纸中的行提取为一张，并用＃N / A排除任何行

Question

我有一张数据表，我需要从多列中提取值并为其分配值。列A是一个字符串，其中列B是分配的值。 C列和D列是基于A列的vlookup，它们也需要B列分配的值。请查看屏幕截图。我需要在另一张纸上编制一个清单。理想情况下，列A具有来自另一张工作表的列A，C和D的数据，列B具有分配的值。唯一需要注意的是，我需要排除任何具有＃N / A

的行

任何可能起作用的宏都会非常有帮助！

我正在使用的代码

Sub Life_Saver_Button()
Dim lastrow As Long, erow As Long

Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")

lastrow = ThisWorkbook.Sheets("S1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
S1.Cells(i, 1).Copy
erow = ThisWorkbook.Sheets("S2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 1)

ThisWorkbook.Sheets("S1").Cells(i, 2).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 2)

ThisWorkbook.Sheets("S1").Cells(i, 3).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 1)

ThisWorkbook.Sheets("S1").Cells(i, 4).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 2)

ThisWorkbook.Sheets("S1").Cells(i, 5).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 1)

ThisWorkbook.Sheets("S1").Cells(i, 5).Copy
ThisWorkbook.Sheets("S1").Paste Destination:=ThisWorkbook.Sheets("S2").Cells(erow, 2)

Next i

Application.CutCopyMode = False
ThisWorkbook.Sheets("S2").Columns().AutoFit
Range("A1").Select

End Sub

Answer 1

尝试：

Option Explicit

Sub test1()

    Dim LastrowA As Long, Lastrow As Long, cell As Range, Code As Long
    Dim Desc As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row

        For Each cell In .Range("A1:D" & LastrowA)

            If Not IsError(cell.Value) = True And Not IsNumeric(cell.Value) = True Then

                Desc = cell.Value
                Code = .Range("B" & cell.Row).Value

                Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

                If LastrowA = Lastrow Then
                    .Range("A" & Lastrow + 2).Value = Desc
                    .Range("B" & Lastrow + 2).Value = Code
                Else
                    .Range("A" & Lastrow + 1).Value = Desc
                    .Range("B" & Lastrow + 1).Value = Code
                End If

            End If

        Next

    End With

End Sub

结果：