我是VBA编程的新手，我有兴趣完成一个我在纸上完成代码的小项目。
问题： 给定26行（按字母顺序A-Z）的数据集及其相应的记录计数，根据公平计数将它们分组为n组（n> 0），其中每个字母对于该组是唯一的。因此，如果组1有A，B，C，则其他组不能使用该字母。
当我解决这篇论文时，这是我的思考过程：
下面是我在c ++中解决这个问题的伪代码以及我手工解决的数据。就像我说的，我对VBA很新，所以我想创建一个宏，如果我将来有另一个文档，将自动解决这个问题。
int totalcount = sum(letter_index)
int index_percent = count/total
int i = 1
int group_i_data_percent_sum = 0.0
int total_percent = 1
int n_groups = 5 //Can vary based on user desired input
while (group_i_data_percent_sum =< total_percent/n_groups)
{
//Check to see if our value is less than total_
if((index_percent + group_i_data_percent_sum) <
total_percent/n_groups)
{
//Add on the data
group_i_data_percent_sum= current_letter_percent + group_i_data_percent_sum
//Store a list of the accepted letters added together.
}
//Otherwise store the list into a data table and increment to next letter
}
//Repeat for all n_groups till all letters are uniquely added to groups.
我为5和6组的手写解决方案。 https://drive.google.com/file/d/0Bz2sgKh9NVmVUGlfZ1NETlJwaTg/view?usp=sharing
答案 0 :(得分：1)
我想回答这个问题，因为这是解释VBA某些功能的好机会。宏代码生成器在记录键击方面占有一席之地，但这里的很多帖子只是自动生成代码的贴片，其中包含如下问题：＆＃34;如何循环播放？＆＃34;
那些希望开发应用程序的人不会使用VBA，但这并不是说VBA是一种较小的语言。如果开发人员远离击键记录并将他的脚趾浸入面向对象编程的水域中，VBA真的相当不错......
VBA的真正优势在于开发人员1）从Excel读取数据，2）完成所有数据处理，3）然后，将结果写回Excel。
下面的代码向您展示了VBA如何通过您概述的任务来实现这一目标。我不得不说我不认为你的步骤是这项任务的最佳解决方案，但我会在这篇文章之外留下。我能告诉你的不是如何将伪代码直接翻译成VBA，而是如何使用VBA的一些对象来实现同样的目的。顺便说一句，我不认为你的伪代码符合你的手写解决方案 - 如果你采用第1组，例如：＆＃39; S＆＃39; S＆＃39; +＆＃39; C＆＃39; = 0.1683710而您的代码不会接受任何超过0.1666667的总数，因此＆＃39; S＆＃39; S＆＃39; S＆＃39;和＆＃39; C＆＃39;不会以编程方式创建相同的组。
无论如何，代码......
首先，添加两个Class Modules（插入 - ＆gt;类模块）。命名第一个cLetterFields并添加以下代码：
Public Letter As String
Public Frequency As Integer
为第二个类命名cAcceptedFields并添加以下代码：
Public TotalFrequency As Integer
Public MemberLetters As Collection
在您的模块中，添加以下过程：
Public Sub RunMe()
Const BOOK_NAME As String = "My Book.xlsm" 'rename to your book
Const SHEET_NAME As String = "Sheet1" 'rename to your sheet
Const READ_ADDRESS As String = "A2:B27" 'amend as suits
Const WRITE_ADDRESS As String = "D2" 'amend as suits
Dim readArray As Variant
Dim writeArray() As Variant
Dim values As cLetterFields
Dim accepted As cAcceptedFields
Dim groupList As Collection
Dim letterList As Collection
Dim nGroups As Integer
Dim totalFrq As Integer
Dim maxGroupFrq As Integer
Dim largestGroupSize As Integer
Dim i As Integer
Dim j As Integer
Dim v As Variant
' Read the values from the worksheet
readArray = Workbooks(BOOK_NAME). _
Worksheets(SHEET_NAME). _
Range(READ_ADDRESS).Value2
' Sort the values
readArray = QSort2D(readArray, 1, UBound(readArray, 1), 2, False)
' Populate the collection of letters and their frequencies
' by assigning values to the cLetterField class.
Set letterList = New Collection
For i = 1 To UBound(readArray, 1)
Set values = New cLetterFields
values.Letter = readArray(i, 1)
values.Frequency = readArray(i, 2)
letterList.Add values, Key:=values.Letter
totalFrq = totalFrq + values.Frequency
Next
nGroups = 6 'amend the acquisition of this as you need.
' Populate the groups.
largestGroupSize = 0
maxGroupFrq = Int(totalFrq / nGroups)
Set groupList = New Collection
For i = 1 To nGroups
' Initialise the group.
Set accepted = New cAcceptedFields
Set accepted.MemberLetters = New Collection
accepted.TotalFrequency = 0
groupList.Add accepted
' Loop through the letters and add them to the group if they fit.
For Each values In letterList
If accepted.TotalFrequency + values.Frequency <= maxGroupFrq Or i = nGroups Then
accepted.MemberLetters.Add values.Letter
accepted.TotalFrequency = accepted.TotalFrequency + values.Frequency
' Remove the accepted letter from the list.
letterList.Remove values.Letter
' Get the group size to dimension our write array.
If accepted.MemberLetters.Count > largestGroupSize Then
largestGroupSize = accepted.MemberLetters.Count
End If
End If
Next
Next
' Write the data to the worksheet.
ReDim writeArray(1 To largestGroupSize + 2, 1 To nGroups + 1)
writeArray(1, 1) = "Counsellor"
writeArray(largestGroupSize + 2, 1) = "TOTAL"
i = 0
For Each accepted In groupList
i = i + 1
writeArray(1, 1 + i) = i
j = 1
For Each v In accepted.MemberLetters
j = j + 1
writeArray(j, 1 + i) = v
Next
writeArray(largestGroupSize + 2, 1 + i) = accepted.TotalFrequency
Next
Workbooks(BOOK_NAME).Worksheets(SHEET_NAME).Range(WRITE_ADDRESS). _
Resize(UBound(writeArray, 1), UBound(writeArray, 2)).Value = writeArray
End Sub
你会看到我引用了一个名为QSort2D的函数，它只是我经常用来对2维数组进行排序的例程。如果您想自己进行排序，请删除该行。如果您需要我的排序功能，请将该行留下并将以下代码粘贴到您的模块中：
Private Function QSort2D(sortArray As Variant, _
bottomIndex As Long, _
topIndex As Long, _
sortIndex As Long, _
ascending As Boolean) As Variant
Dim lowIndex As Long
Dim hiIndex As Long
Dim swapValue As Variant
Dim tempValue As Variant
Dim y As Long
lowIndex = bottomIndex
hiIndex = topIndex
swapValue = sortArray((bottomIndex + topIndex) \ 2, sortIndex)
Do While lowIndex <= hiIndex
If ascending Then
Do While sortArray(lowIndex, sortIndex) < swapValue And lowIndex < topIndex
lowIndex = lowIndex + 1
Loop
Do While sortArray(hiIndex, sortIndex) > swapValue And hiIndex > bottomIndex
hiIndex = hiIndex - 1
Loop
Else
Do While sortArray(lowIndex, sortIndex) > swapValue And lowIndex < topIndex
lowIndex = lowIndex + 1
Loop
Do While sortArray(hiIndex, sortIndex) < swapValue And hiIndex > bottomIndex
hiIndex = hiIndex - 1
Loop
End If
If lowIndex <= hiIndex Then
For y = LBound(sortArray, 2) To UBound(sortArray, 2)
tempValue = sortArray(lowIndex, y)
sortArray(lowIndex, y) = sortArray(hiIndex, y)
sortArray(hiIndex, y) = tempValue
Next
lowIndex = lowIndex + 1
hiIndex = hiIndex - 1
End If
Loop
If bottomIndex < hiIndex Then sortArray = QSort2D(sortArray, bottomIndex, hiIndex, sortIndex, ascending)
If topIndex > lowIndex Then sortArray = QSort2D(sortArray, lowIndex, topIndex, sortIndex, ascending)
QSort2D = sortArray
End Function