Question

我有一张Excel表格，其中包含约150名员工的条目。每行包含名称以及工作时间，工资，团队等等。每行中的B列包含最后一种格式的员工姓名。表格中大约一半的员工是兼职员工。我正在尝试做的是在VB中编写一个宏来复制整行，如果B列中的名称与兼职员工的名字之一匹配，那么我的一个同事可以简单地运行宏并粘贴所有每周将复制用户的行放入新工作表中。这就是我现在拥有的。（我有阵列中的所有员工姓名，但我已经审查了他们）我真的不太理解最后50％的代码。这些东西是我在网上找到的东西，并且一直在乱搞。

`Sub PartTime()
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean


nameArray = Array(NAMES CENSORED)

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add

For I = 1 To NoRows

    Set rngCells = wsSource.Range("C" & I & ":F" & I)
    Found = False
    For J = 0 To UBound(strArray)
        Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
    Next J

    If Found Then
        rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

        DestNoRows = DestNoRows + 1
    End If
  Next I
End Sub`

Answer 1

此代码适用于您要查找的内容。重要的是要注意，数组中的字符串名称必须与B列中的字符串名称相同（前导和尾随空格除外），因此如果名称是＆＃34; LastName，FirstName＆＃34;那么你的输入数据必须是相同的。这段代码可以调整为没有这个要求，但是现在我已经离开了它。如果您希望调整代码，请与我们联系。

Option Explicit

Sub PartTimeEmployees()

Dim NewSheet As Worksheet, CurrentSheet As Worksheet, NameArray As Variant
Set CurrentSheet = ActiveWorkbook.ActiveSheet
Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count))
NewSheet.Name = "Part Time Employees"
NameArray = Array("NAMES CENSORED")

'Pulling headers from the first row
CurrentSheet.Rows(1).EntireRow.Copy
NewSheet.Select 'Redundant but helps avoid the occasional error
NewSheet.Cells(1, 1).Select
ActiveSheet.Paste
CurrentSheet.Select
Dim NextRow As Long
NextRow = 2

'Writing this code to not assume that the data is continuous
Dim Count As Long
'Iterating to the end of the data in the sheet
For Count = 2 To CurrentSheet.UsedRange.Rows.Count
    If Not IsEmpty(CurrentSheet.Cells(Count, 2)) Then
        For Counter = 1 To UBound(NameArray)
            'Performing string operations on the text will be faster than the find method
            'It is also essential that the names are entered identically in your array
            If UCase(Trim(CurrentSheet.Cells(Count, 2).Value)) = UCase(NameArray(Counter)) Then
                CurrentSheet.Rows(Count).Copy
                NewSheet.Select
                NewSheet.Cells(NextRow, 1).Select
                ActiveSheet.Paste
                CurrentSheet.Select
                NextRow = NextRow + 1
                Exit For
            End If
        Next Counter
    End If
Next Count

End Sub

Answer 2

如果使用带有数组作为条件的Range.AutoFilter Method，则无需遍历数组。

查看每行操作代码的注释。

Count

如果单元格包含数组中的名称，则复制Excel中的行

2 个答案: