從列中刪除前n個值的實例

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的值超過實際輸入的數量，則會導致錯誤。如果您在實施時遇到任何問題，只需留言。希望這可以幫助。