excel vba filling array
I have the following problem. I have a userform with entry fields. The user is going to ent开发者_StackOverflower a number for participants. I have four groups of participants:
Group A: 5 Group B: 6 Group C: 1 Group D: 2
Each participant should be named like this: {GA1, GA2, ..., GD2} I wanted to write this into an array in that order and then use this array to fill cells with the names but all I came up with were four for-loops to write it into the array and that failed too. Is there a better way to do this?
Dim GA As Integer
Dim GB As Integer
Dim GC As Integer
Dim GD As Integer
Dim PartSum As Integer
GA = TextBox32.Value
GB = TextBox33.Value
GC = TextBox34.Value
GD = TextBox35.Value
PartSum = GA + GB + GC + GD
Dim NamingArray() As String
ReDim NamingArray(1 To PartSum)
For i = 0 To GA
NamingArray(i) = "GA " & CStr(i)
Next i
For j = GA To GA + GB
NamingArray(i) = "GB " & CStr(j)
Next j
For k = GA + GB To GA + GB + GC
NamingArray(i) = "GC " & CStr(k)
Next k
For l = GA + GB + GC To GA + GB + GC + GD
NamingArray(i) = "GD " & CStr(l)
Next l
'check entries
For i = LBound(NamingArray) To UBound(NamingArray)
MsgBox (NamingArray(i))
Next i
I can see three reasons why your code isn't behaving like you expect.
First, the variables you use as indices in your For ... Next
loops are inconsistent. In this loop, for instance, you increment k
but use i
to index into NamingArray
. Note that i
still has the value GA+1
left over from the first loop.
For k = GA + GB To GA + GB + GC
NamingArray(i) = "GC " & CStr(k)
Next k
Just use i
for all your loops. No need to use a different letter every time.
Second, you try to access element 0 of NamingArray
, which doesn't exist.
ReDim NamingArray(1 To PartSum) ' starts at 1
For i = 0 To GA
NamingArray(i) = "GA " & CStr(i) ' attempt to refer to NamingArray(0)
Next i
Third, your indexing is completely messed up more generally. For instance, NamingArray(GA)
will be written to at the end of your first loop, and then overwritten at the beginning of your second loop. This happens for all your loops; their "jurisdictions" overlap (sorry, I'm Canadian). I've corrected this (and all the other errors) below. This works:
For i = 1 To GA
NamingArray(i) = "GA " & CStr(i)
Next i
For i = 1 + GA To GA + GB
NamingArray(i) = "GB " & CStr(i - GA)
Next i
For i = 1 + GA + GB To GA + GB + GC
NamingArray(i) = "GC " & CStr(i - GA - GB)
Next i
For i = 1 + GA + GB + GC To GA + GB + GC + GD
NamingArray(i) = "GD " & CStr(i - GA - GB - GC)
Next i
Now to answer your question: Is there a better way to do this? Yes. But this works fine, and though it isn't pretty, it isn't inefficient in any way.
Why bother with an array? Declare an int as a cursor
Assuming you want them across row 1
dim col as integer
dim Acount as integer (etc)
'get Acount, Bcount etc from form
for col 1 =1 to Acount
cells(1,col).value = "GA" & col
next
for col =1 Acount to Bcount-1
cells(1,col).value = "GB" & col
next
etc
If the list isn't going to change, then your array might be simply declared something like this:
Dim participantNames
participantNames = Array("GA1","GA2","GA3","GA4","GA5","GB1","GB2","GB3","GB4","GB5","GB6","GC1","GD1","GD2")
If the list of letters and counts might vary, then you probably need a function, something like:
Option Explicit
Public Function GroupIDs(grpNames, grpCounts) As Variant
Dim grpIndex
Dim countIndex
Dim output As New Collection
For grpIndex = LBound(grpNames) To UBound(grpNames)
For countIndex = 1 To grpCounts(grpIndex)
output.Add "G" & grpNames(grpIndex) & countIndex
Next
Next
ReDim outputArray(1 To output.Count)
For countIndex = 1 To output.Count
outputArray(countIndex) = output(countIndex)
Next
GroupIDs = outputArray
End Function
... which you might call with:
GroupIds(Array("A", "B", "C", "D"),Array(5, 6, 1, 2))
Name your textboxes tbxGA, tbxGB, tbxGC, and tbxGD, and use this code to write to a range.
Private Sub cmdWrite_Click()
Dim i As Long, j As Long
Dim ctl As Control
Dim lCnt As Long
Dim aOutput() As String
Dim lTotal As Long
For i = 65 To 68
Set ctl = Me.Controls("tbxG" & Chr$(i))
lTotal = lTotal + Val(ctl.Text)
Next i
ReDim aOutput(1 To lTotal, 1 To 1)
For i = 65 To 68
Set ctl = Me.Controls("tbxG" & Chr$(i))
For j = 1 To Val(ctl.Text)
lCnt = lCnt + 1
aOutput(lCnt, 1) = "G" & Chr$(i) & j
Next j
Next i
Sheet1.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
Unload Me
End Sub
精彩评论