☰

根据条件将数据传送到工作簿中的新工作表的宏

tag-icon • tag-icon microsoft-excel macros
根据条件将数据传送到工作簿中的新工作表的宏

我需要帮助编写一个宏，以便将超过 5 列的数据带到同一工作簿中的新工作表中。背景：第一个工作表是所有在职员工的主列表，我们想使用一个宏，根据列中的条件 =“特定文本”将员工带到第二个工作表中。

这种跟踪每天都会进行，并且宏应该能够删除前一天已经带来的员工，这样我们就不会得到重复的数据。

答案1

我已经创建了一个示例 Excel 宏工作簿，其中的宏中有注释 - 您应该能够根据需要对其进行修改。

在此处下载宏 Excel 工作簿

也在这里粘贴代码...

Sub copyDataBasedOnCriteria()

Dim i As Integer
Dim columnToCheck As Integer
Dim outputRow As Integer

'-------------------------------------------
'Initialize these based on your requirement
'-------------------------------------------
numColumns = 5 'this is the number of columns in your data
numRows = 11 'this is the last row till where you have data, including header
columnToCheck = 4 'want to match the 4th column, D
filterValue = "Value 3" 'want to copy those employees where the data in field 'Attribute # 3' = 'Value 3'
'-------------------------------------------

Sheets("Destination").Activate
Cells.Select
Selection.ClearContents

For i = 1 To numColumns
    outputRow = 2
    Sheets("Destination").Range(whichCol(i) & "1").Value = Sheets("Source").Range(whichCol(i) & "1").Value
    For j = 2 To numRows
        If Sheets("Source").Range(whichCol(columnToCheck) & j).Value = filterValue Then
            Sheets("Destination").Range(whichCol(i) & outputRow).Value = Sheets("Source").Range(whichCol(i) & j).Value
            outputRow = outputRow + 1
        End If
    Next j
Next i

Sheets("Destination").Cells.Select
Cells.EntireColumn.AutoFit

End Sub

Function whichCol(colNumber As Integer) As String
    Dim vArr
    vArr = Split(Cells(1, colNumber).Address(True, False), "$")
    whichCol = vArr(0)
End Function

相关内容