从列

Question

我正在开发一个宏，用于匹配列中具有特定值的人。但是，部分宏允许用户从每个人分配给他们的总数中删除一定百分比的人。数据如下所示：

Data |   Name
--------------
1234 | Person1
3456 | Person1
8768 | Person2
0878 | Person3
4132 | Person5
0986 | Person1
0182 | Person5
0197 | Person4
4501 | Person2
4132 | Person2
8126 | Person4
0172 | Person4
0911 | Person4
0751 | Person3
6681 | Person1
8819 | Person2

到目前为止，宏的相关部分如下所示：

Sub Load_Balancing()
Dim i as integer, j as integer, k as integer
Dim Vacay as string, Vacaypercent as string
Dim Person as Long, Person1 As long, Person1Int as Long, LastRowVacay as Long

Person = Application.WorksheetFunction.CountIf(Range("B:B"), "=Person1")

For i = 3 To 18
    Vacay = Application.InputBox("Enter Name", "Enter full name",Type:=2) 
    If Len(Vacay) = 0 Then Exit For
    ws.Cells(i, 6).Value = Vacay
    Vacay = ""
    Vacaypercent = Application.InputBox("Enter percent reduction", 
"Enter % reduction", Type:=2)
    ws.Cells(i, 7).Value = Vacaypercent
    Vacaypercent = ""
Next i

LastRowVacay = ws.Cells(Rows.Count, "F").End(xlUp).Row

For j = 3 To LastRowVacay
    Cells(j, 7).Value = (Cells(j, 7).Value * 0.01)
Next j

j = 0
For j = 3 To LastRowVacay
    On Error Resume Next
    If Cells(j, 6).Value = "Person1 Name" Then
        Person1Int = WorksheetFunction.Round(Person1 * Cells(j, 7).Value)
        k = 0
        For k = 3 To LastRowAssignments
'This is where the relevant code should go
    Else: Exit For
    End If
Next j
End Sub

基本上，我想要的是当用户输入一个人的名字和所需的减少百分比时，宏应该删除该人的名字，即分配给他们的总数百分比，留下一个空白细胞在他们的位置。例如，Person1在样本数据中出现4次。当用户键入Person1和50时，应该从列表中删除Person1的前两个实例，只留下：

Data |   Name
--------------
1234 | 
3456 | 
8768 | Person2
0878 | Person3
4132 | Person5
0986 | Person1
0182 | Person5
0197 | Person4
4501 | Person2
4132 | Person2
8126 | Person4
0172 | Person4
0911 | Person4
0751 | Person3
6681 | Person1
8819 | Person2

但是，我不知道该怎么做。我知道我需要使用计数器才能有效，但我无法弄清楚它应采取什么形式。任何建议将不胜感激！

Answer 1

NLourme， 下面的内容应该适合你：

Sub test()
    Call killnValues("Person1", 2)
End Sub

Function killnValues(theText, n)
    Row = 0
    While x < n
        Row = Row + 1
        If Cells(Row, 2) = theText Then
            Cells(Row, 2) = Empty
            x = x + 1
        End If
    Wend
End Function

显然，你必须相应地修改它以满足你的需要，包括注意正确设置n的值。如果n的值超过实际条目的数量，将导致错误。如果您在实施过程中遇到任何问题，请大声说出来。希望这会有所帮助。