我是Excel VBA的初学者，我正在尝试将代理名称/ ID平均划分为组，其中每个成员根据其Crift数据进行分类，无论代理是推荐者，中立者还是擅离者。除此之外，那些具有Crift分类的代理商可以确定他们是否有销售或没有销售......最后一件事，呼叫的持续时间（即短（小于10分钟），中（10-20分钟）和长（以上）由代理人承诺的20分钟）对每个小组平均分配，以便在一个小组中有短期，中期和长期的呼叫进行评估。
Agent Name/ID Sales/NonSales Crift (P-N-D) Call Duration (in min) Repeats
152325 N N 8.00 Y
152336 Y N 12.00 Y
152040 Y P 10.00 Y
152041 Y P 13.00 Y
152046 N D 10.00 N
152189 N N 15.00 Y
151794 Y P 24.00 N
152052 Y P 20.00 Y
151906 Y P 23.50 N
151909 N D 15.67 Y
151893 N N 20.36 N
152048 Y D 21.00 N
151903 Y N 19.00 N
152044 Y P 18.25 N
152032 N P 29.15 Y
152290 Y N 26.00 N
151740 N D 10.00 Y
168334 N D 6.00 N
200679 Y N 8.00 Y
152037 N D 7.56 Y
152026 Y D 8.16 Y
152055 Y P 9.28 Y
152307 N P 4.26 N
152132 Y P 16.64 N
152004 N D 16.16 Y
152017 Y P 25.00 Y
152021 N D 26.00 Y
151914 N P 29.16 Y
151922 N N 24.98 Y
我非常感谢你的帮助。
答案 0 :(得分：0)
Private Type Records
Dimension() As Double
Distance() As Double
Cluster As Integer
End Type
Dim Table As Range
Dim Record() As Records
Dim Centroid() As Records
Sub Run()
If Not Grouping Then
Call MsgBox("Error: " & Err.Description, vbExclamation, "Clustering Error")
End If
End Sub
Function Grouping() As Boolean
Dim Site As String
Site = Application.InputBox("VXI Site")
Worksheets("Data Base").Activate
Range("B1").Select
ActiveCell.Offset(2, 0).Value = Site
Cells(2, 1).Font.Bold = True
Cells(2, 2).HorizontalAlignment = xlCenter
Dim numClusters As Integer
numClusters = Application.InputBox("Specify Number of QA Evaluator", "Grouping", Type:=1)
ActiveCell.Offset(3, 0).Value = numClusters
Cells(4, 2).Font.Bold = True
Cells(4, 2).HorizontalAlignment = xlCenter
If Not numClusters > 0 Or numClusters = False Then
Exit Function 'Cancelled
End If
MsgBox Site & " was an identified site" & " with " & numClusters & " QA Evaluators."
Dim dataSheet, groupSheet As Worksheet
Set groupSheet = Worksheets("Grouping")
Set dataSheet = Worksheets("Data Base")
'dataSheet.Range("A7:A100000").Copy Destination:=dataSheet.Range("g:g")
Dim numAgent As Integer
numAgent = dataSheet.Range("A7:A100000").End(xlDown).Row
Dim startRow As Integer
startRow = 2
Dim startCol As Integer
startCol = 1
Dim agentNumber As Integer
For i = 1 To numClusters
For j = 1 To Round(numAgent / numClusters, 0)
agentNumber = Int((numAgent - 1 + 1) * Rnd() + 1)
groupSheet.Cells(startRow, startCol).Value = dataSheet.Cells(agentNumber, 7).Value
dataSheet.Cells(agentNumber, 7).Delete Shift:=xlUp
numAgent = numAgent - 1
startRow = startRow + 1
Next j
If i < 7 Then
startRow = 2
startCol = startCol + 1
ElseIf i = 7 Then
startRow = 14
startCol = 1
Else
startRow = 14
startCol = startCol + 1
End If
Next i
Grouping_Error:
Grouping = (Err.Number = 0)
End Function
Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 7
LSearchRow = 7
'Start copying data to row 4 in Grouping (row counter variable)
LCopyToRow = 4
While Len(Range("A" & CStr(LSearchRow)).Value) < 10
'If value in column E = "Mail Box", copy entire row to Sheet2
If Range("E" & CStr(LSearchRow)).Value = "Y" And "N" Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Grouping").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Data Base").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub