开发者

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
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜