안녕하세요~

vba 코딩입니다.
아래 첨부파일로 한번 해보세요^^

Public Sub 총점배분()
'// =====================================================
'// 총점을 4개 평가 항목에 랜덤 배분
'// - 각 항목 최소 1점 이상
'// - 각 항목 만점 이내
'// - 총점과 합계 일치
'// =====================================================

    On Error GoTo EH

    '// ----- 기본 변수 -----
    Dim ws As Worksheet:   Set ws = ThisWorkbook.Worksheets("평가서")
    Dim r As Long, i As Long
    Dim fRow As Long, eRow As Long
    Dim tot As Long, remain As Long

    '// ----- 점수 관련 -----
    Dim maxArr(1 To 4) As Long      '// 각 항목 만점
    Dim s(1 To 4) As Long           '// 각 항목 점수
    Dim maxTot As Long              '// 총 만점

    '// ----- 랜덤 배분 -----
    Dim avItems() As Long           '// 배분 가능한 항목 인덱스
    Dim avCnt As Long               '// 배분 가능 항목 수
    Dim sIdx As Long                '// 선택된 항목 인덱스
    Dim LCnt As Long                '// 무한루프 방지용

    '// ----- 환경 백업 -----
    Dim pCalc As XlCalculation
    Dim pUpd As Boolean
    Dim pEvt As Boolean

    pCalc = Application.Calculation
    pUpd = Application.ScreenUpdating
    pEvt = Application.EnableEvents

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    '// ===== 만점 설정 =====
    maxArr(1) = 10      '// 평가1
    maxArr(2) = 8       '// 평가2
    maxArr(3) = 6       '// 평가3
    maxArr(4) = 6       '// 평가4

    For i = 1 To 4
        maxTot = maxTot + maxArr(i)
    Next i

    '// ===== 데이터 범위 =====
    fRow = 10
    eRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    If eRow < fRow Then
        MsgBox "처리할 데이터가 없습니다.", vbInformation
        GoTo Done
    End If

    '// ===== 난수 초기화 =====
    Randomize

    '// ===== 행별 처리 =====
    For r = fRow To eRow

        '// -- 총점 읽기/보정 --
        tot = CLng(Val(ws.Cells(r, "F").Value))
        If tot < 0 Then tot = 0
        If tot > maxTot Then tot = maxTot

        '// -- 4점 미만이면 배분 불가 → 초기화 후 다음 행 --
        If tot < 4 Then
            ws.Range("B" & r & ":E" & r).ClearContents
            GoTo NextRow
        End If

        '// -- 점수 초기화 후 최소 1점씩 배정 --
        For i = 1 To 4
            s(i) = 1
        Next i
        remain = tot - 4

        '// -- 남은 점수 랜덤 배분 --
        LCnt = 0
        ReDim avItems(1 To 4)

        Do While remain > 0
            LCnt = LCnt + 1
            If LCnt > 10000 Then Exit Do   '// 안전장치

            '// 배분 가능 항목 수집
            avCnt = 0
            For i = 1 To 4
                If s(i) < maxArr(i) Then
                    avCnt = avCnt + 1
                    avItems(avCnt) = i
                End If
            Next i

            '// 더 이상 배분할 곳이 없으면 종료
            If avCnt = 0 Then Exit Do

            '// 가능한 항목 중 하나 랜덤 선택
            sIdx = avItems(Int(Rnd() * avCnt) + 1)

            s(sIdx) = s(sIdx) + 1
            remain = remain - 1
        Loop

        '// -- 시트에 기록 (B~E 열) --
        ws.Cells(r, "B").Resize(, 4).Value = Array(s(1), s(2), s(3), s(4))

NextRow:
    Next r

    MsgBox "총점 배분이 완료되었습니다." & vbCrLf & _
           "범위: " & fRow & " ~ " & eRow & "행", vbInformation

Done:
    '// ===== Excel 환경 복원 =====
    Application.ScreenUpdating = pUpd
    Application.Calculation = pCalc
    Application.EnableEvents = pEvt
    Exit Sub

EH:
    '// ===== 에러 처리 =====
    Application.ScreenUpdating = pUpd
    Application.Calculation = pCalc
    Application.EnableEvents = pEvt

    MsgBox "오류가 발생했습니다." & vbCrLf & vbCrLf & _
           "에러 번호: " & Err.Number & vbCrLf & _
           "에러 내용: " & Err.Description & vbCrLf & _
           "행 번호: " & r, vbCritical, "총점_배분_자동_배열"
End Sub

​

F10
=INDEX($B$4:$O$4,1,$G10)

B10
=IFERROR( RANDBETWEEN(MAX(1,$F10-(SUM($A10:A10,C$9:$F$9))),
MIN($F10-(SUM($A10:A10)+COLUMNS(C10:$E10)),B$9)),$E10-SUM($A10:A10))

​

왜 이런게 필요한 건가요?

파워쿼리로 만들어 봅니다.

1 평가항목 추가(평가4, 평가5~~) 가능

2 평가항목별 점수대를 다르게 할 경우도 가능(평가1은 10점까지, 평가2는 5점까지만)

​

​<응용1> - 평가항목 추가, 평가항목별 점수대 상이