将A列的数，拆分到D、F、H、J、L、N列，6列拆完

heier2

问了GPT一晚上也问不出来，只能来这里求助了

cnmlgb9998

这种题 太无趣了。真的。烧脑，没意思 。

陈正

这是奥赛选拔吗

LIUZHU

是每个数据都必须拆分出6个数吗？

heier2

LIUZHU 发表于 2024-3-26 09:00
是每个数据都必须拆分出6个数吗？

不一定，看前面用了多少，用完了后面为空

LIUZHU

heier2 发表于 2024-3-26 09:58
不一定，看前面用了多少，用完了后面为空

你是不是得上传个附件？

heier2

已上传附件

heier2

LIUZHU 发表于 2024-3-26 10:22
你是不是得上传个附件？

已上传附件，谢谢

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, cr, i&, j&, iRndNum&, t#, iPosCol&
   
    t = Timer
    ar = Range("A2", Cells(Rows.Count, "A").End(xlUp))
    ReDim br(1 To UBound(ar), 1 To 11)

    For i = 1 To UBound(ar)
        Do
            iRndNum = WorksheetFunction.RandBetween(1, 6)
            cr = rndNumIsTotalSum(1, ar(i, 1), iRndNum, ar(i, 1))
        Loop Until WorksheetFunction.Max(cr) <= 15
        bSort1 cr, 1, UBound(cr), False
        For j = 1 To UBound(cr)
            iPosCol = (j - 1) * 2 + 1
            br(i, iPosCol) = cr(j)
        Next j
    Next i
   
    [D2].Resize(UBound(br), UBound(br, 2)) = br
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub
Function bSort1(ar, iFirst&, iLast&, Optional isOrder As Boolean = True)
    Dim i&, j&, vTemp
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j) <> ar(j + 1) Then
                If ar(j) < ar(j + 1) Xor isOrder Then
                    vTemp = ar(j): ar(j) = ar(j + 1): ar(j + 1) = vTemp
                End If
            End If
        Next j
    Next i
End Function
Function rndNumIsTotalSum(ByVal iMinNum&, ByVal iMaxNum&, ByVal iCount&, ByVal iSumNum&)
    Dim ar(), i&, iAverage&, iRnd1&, iRnd2&, iRndNum&, iBal1&, iBal2&
   
    ReDim ar(1 To iCount)
    iAverage = Int(iSumNum / iCount)
    If iAverage < iMinNum Or iAverage > iMaxNum Then
        For i = 1 To UBound(ar): ar(i) = "无解！": Next
        rndNumIsTotalSum = ar: Exit Function
    End If
    For i = 1 To UBound(ar)
        ar(i) = iAverage
    Next i
    For i = 1 To (iSumNum - iAverage * iCount)
        ar(i) = ar(i) + 1
    Next i
    Randomize
    For i = 1 To iCount
        iRnd1 = Int(iCount * Rnd + 1): iRnd2 = Int(iCount * Rnd + 1)
        iBal2 = iMaxNum - ar(iRnd2): iBal1 = ar(iRnd1) - iMinNum
        If iBal2 < iBal1 Then iRndNum = iBal2 Else iRndNum = iBal1
        ar(iRnd1) = ar(iRnd1) - iRndNum
        ar(iRnd2) = ar(iRnd2) + iRndNum
    Next i
   
    rndNumIsTotalSum = ar
End Function

gwjkkkkk

请参考附件。。。