배열 값을 계속 더하려 하는데 더해지지 않는 것 같습니다.

VBA
작성자
코코
작성일
2021-11-24 15:12
조회
31
엑셀버전 : M365

운영체제 : 윈도우10

함수는 a(evs, dg)로 evs는 나눌 그룹 수, dg는 인원 수 입니다

이전 내용은 문제없이 실행되서 이부분부터 복사하였습니다

아래 내용을 실행하면 evs값이 작을 수록 var(i)값이  커져야 하는데 evs와 관련없이 거의 똑같았습니다.

For i = 1 To evs     '1부터 evs그룹까지

dgs = Int(Rnd * 10)    '첫 랜덤 숫자

For m = 1 To Int(dg / 10) + 1    'dg를 입력받고 evs그룹에 나눠 담으므로 한 그룹마다 dg/10 + 1보다 반복될 수 없으므로 이렇게 설정                                             '했습니다

If edg(i) > 0 Then   'edg(i)는 각 그룹에 있는 인원 수로 이전 내용에서 값이 주어졌습니다.

If edg(i) < 10 Then   '그룹 인원이 10명 이하인 경우 각 mc, cg값을 설정하고 var(i)를 구하고 그룹인원을 10명 빼줬습니다. 이전 내용에                              '서 var(i)는 모두 0으로 설정했습니다.

mc = Int(Rnd * edg(i)) + 1
edg(i) = edg(i) - 10
cg = Int(Rnd * (10 - mc)) + mc + 1
var(i) = dgs + var(i) + mc * 3 + cg

Else      'edg(i)가 10보다 크면 10명이하인 경우와 mc를 다르게 설정하여 var(i)를 구하고

mc = Rnd * 9 + 1
edg(i) = edg(i) - 10
cg = Int(Rnd * (10 - mc)) + mc + 1
var(i) = dgs + var(i) + mc * 3 + cg

dgs = cg       '인원수 10명을 빼도 0명보다 많기 때문에 다음 실행 때 dgs값을 cg와 같게 하도록 설정했습니다

End If
Else             '10을 뺐을 때 인원 수가 0보다 작거나 같을 경우 m을 사용한 for문을 벗어나도록 했습니다
Exit For

End If
Next m        '그룹에 인원이 남아있으면 var(i)값을 계속 더합니다

Next i         '1그룹의 var(1)을 구하였으면 2그룹으로 넘어갑니다


전체 내용

Function a(evs, dg)

Dim result
Dim dgs
Dim mc
Dim cg

Dim edg()
ReDim edg(1 To evs)

Dim var()
ReDim var(1 To evs)

result = 0 '초기화'

For p = 1 To evs '초기화'
edg(p) = 0
Next p

For q = 1 To evs '초기화'
var(q) = 0
Next q

Do While (dg <> 0) '인원이 없어질 때 까지 반복

For k = 1 To evs '조 1,2,3에 돌아가며 한명씩 넣음
If dg = 0 Then '인원이 모두 분배되었을 경우 빠져나옴
Exit For
Else
edg(k) = edg(k) + 1 'k번째 조에 1명을 넣음
dg = dg - 1 '총 인원이 한명 줄어듦
End If
Next k

Loop

For i = 1 To evs

dgs = Int(Rnd * 10)

For m = 1 To Int(dg / 10) + 1

If edg(i) > 0 Then

If edg(i) < 10 Then

mc = Int(Rnd * edg(i)) + 1
edg(i) = edg(i) - 10
cg = Int(Rnd * (10 - mc)) + mc + 1
var(i) = dgs + var(i) + mc * 5 + cg

Else

mc = Rnd * 9 + 1
edg(i) = edg(i) - 10
cg = Int(Rnd * (10 - mc)) + mc + 1
var(i) = dgs + var(i) + mc * 5 + cg

dgs = cg

End If
Else
Exit For

End If
Next m

Next i

For j = 1 To evs '비교 후 가장 더 큰 것을 내보냄

If var(j) > result Then
result = var(j)

Else
result = result

End If

Next j

a = result

 

End Function

전체 1

  • 2021-11-24 16:16

    해결해야할 문제가 무엇인지도 모른 채 그저 코드 분석만 원하니 도움 드리기가 좀 막연합니다.

    다만 주석 처리한 부분은 '=============== 로 둘러쌓인 부분으로 대체해도 괜찮을 듯해요.

    다음이 수정된 코드입니다

    Function a(evs, dg)

    Dim result
    Dim dgs
    Dim mc
    Dim cg

    Dim edg()
    ReDim edg(1 To evs)

    Dim var()
    ReDim var(1 To evs)

    result = 0 '초기화'

    For p = 1 To evs '초기화'
    edg(p) = 0
    Next p

    For q = 1 To evs '초기화'
    var(q) = 0
    Next q

    '========================================================================
    su = Int(dg / evs)          '각 조에 기본적으로 들어가야할 인원수
    remainder = dg - su * evs   '기본 분배가 이루어진 후 나머지

    For k = 1 To evs
    edg(k) = su             '각 조에 기본 분배 인원수 할당
    Next k

    For k = 1 To remainder
    edg(k) = edg(k) + 1     '나머지 인원을 해당 조까지 분배
    Next k
    '========================================================================

    '    Do While (dg <> 0) '인원이 없어질 때 까지 반복
    '
    '        For k = 1 To evs '조 1,2,3에 돌아가며 한명씩 넣음
    '            If dg = 0 Then '인원이 모두 분배되었을 경우 빠져나옴
    '                Exit For
    '            Else
    '                edg(k) = edg(k) + 1 'k번째 조에 1명을 넣음
    '                dg = dg - 1 '총 인원이 한명 줄어듦
    '            End If
    '        Next k
    '
    '    Loop

    For i = 1 To evs

    dgs = Int(Rnd * 10)     '0~9 사이의 난수

    For m = 1 To Int(dg / 10) + 1

    If edg(i) > 0 Then

    If edg(i) < 10 Then

    mc = Int(Rnd * edg(i)) + 1
    edg(i) = edg(i) - 10
    cg = Int(Rnd * (10 - mc)) + mc + 1
    var(i) = dgs + var(i) + mc * 5 + cg

    Else

    mc = Rnd * 9 + 1
    edg(i) = edg(i) - 10
    cg = Int(Rnd * (10 - mc)) + mc + 1
    var(i) = dgs + var(i) + mc * 5 + cg

    dgs = cg

    End If
    Else
    Exit For

    End If
    Next m

    Next i

    For j = 1 To evs '비교 후 가장 더 큰 것을 내보냄

    If var(j) > result Then
    result = var(j)

    Else
    result = result

    End If

    Next j

    a = result

    End Function


전체 4,648
번호 카테고리 제목 작성자 작성일 추천 조회
공지사항 공지사항
⭐ [더 나은 커뮤니티 문화를 위한 Q&A 글 작성 규칙] ⭐ (8)
오빠두엑셀 | 2021.10.28 | 추천 14 | 조회 702
트로피 오빠두엑셀 2021.10.28 14 702
24154 피벗테이블
New 설문조사 피벗테이블 구성이 어렵네요 첨부파일
가리 | 12:22 | 추천 0 | 조회 10
가리 12:22 0 10
24153 VBA
New 엑셀 검색 창 첨부파일 (1)
이혜 | 11:59 | 추천 0 | 조회 13
이혜 11:59 0 13
24149 VBA
New 엑셀 메일 보내기 자동화 매크로 관련 (저장경로 변경, 일정한 셀 값의 변화로 매크로 반복) 첨부파일
| 10:48 | 추천 0 | 조회 22
10:48 0 22
24148 피벗테이블
New 피벗테이블 형태의 데이터베이스 변환
이길호 | 10:34 | 추천 0 | 조회 17
이길호 10:34 0 17
24140 VBA
New 특정 시트에 추출되어있는 값을 각각의 시트로 분류하려고합니다. 첨부파일 (1)
이치영 | 01:37 | 추천 0 | 조회 35
이치영 01:37 0 35
24135 VBA
New vlookup #N/A 에러가 나오는 경우 IF문은 어떻게.... (2)
툴잇지 with 우정기기 | 2021.11.29 | 추천 0 | 조회 46
툴잇지 with 우정기기 2021.11.29 0 46
24132 함수/공식
New 동적범위, 셀값을 시트명으로 인식하여 합계를 구하는것 첨부파일 (6) 답변완료
키큰아저씨 | 2021.11.29 | 추천 0 | 조회 48
키큰아저씨 2021.11.29 0 48
24129 VBA
New 직사각형 도형 삭제vba (2) 답변완료
H.B | 2021.11.29 | 추천 1 | 조회 32
H.B 2021.11.29 1 32
24126 VBA
New "요청한 레지스트리에 엑세스할 수 없습니다." 라는 에러때문에 진행이 안됩니다. (3)
볼펜수리공 | 2021.11.29 | 추천 0 | 조회 29
볼펜수리공 2021.11.29 0 29
24120 기능/도구
New 조건부서식으로 찾은 바탕색을 실제 엑셀 바탕색 컬러로 변경하고 싶습니다. 첨부파일 (2) 답변완료
glas**** | 2021.11.29 | 추천 0 | 조회 34
glas**** 2021.11.29 0 34
24117 함수/공식
New 맨 끝자리를 제외한 7자리 추출 첨부파일 (2) 답변완료
감사하모니카 | 2021.11.29 | 추천 0 | 조회 40
감사하모니카 2021.11.29 0 40
24116 VBA
New VBA 2007버전과 2021버전에서의 속도 차이가 많이 납니다. 해결방안이 있을까 해서요? 첨부파일 (2)
한정석 | 2021.11.29 | 추천 0 | 조회 44
한정석 2021.11.29 0 44
24113 함수/공식
New 조건 서식 질문입니다. 첨부파일 (1)
space | 2021.11.29 | 추천 0 | 조회 38
space 2021.11.29 0 38
24111 피벗테이블
New 피벗테이블 DAX함수 관련 문의
T첫 | 2021.11.29 | 추천 0 | 조회 24
T첫 2021.11.29 0 24
24106 함수/공식
New 엑셀에서 해당 날짜기간 동안을 찾아 날짜열에 각각 표기하는 방법 첨부파일 (5)
공수래 | 2021.11.29 | 추천 0 | 조회 39
공수래 2021.11.29 0 39
24099 함수/공식
New 입력한 값에 따라 IMAGE 자동입력 함수 문제 관련 (1)
유지연 | 2021.11.29 | 추천 0 | 조회 28
유지연 2021.11.29 0 28
24098 VBA
New 워드 Format(숫자, "#,###") (1) 답변완료
argus | 2021.11.28 | 추천 0 | 조회 38
argus 2021.11.28 0 38
24097 VBA
New 각각 형식이 다른 여러 시트에서 원하는 값들만 가져와서 한 시트에 보기 쉽게 합치고 싶습니다. 첨부파일 (1)
축전 | 2021.11.28 | 추천 0 | 조회 42
축전 2021.11.28 0 42
24096 VBA
New 엑셀 재고관리툴 만들기 VBA영상 시청중 오류 발생관련 문의입니다. 첨부파일
가을전어 | 2021.11.28 | 추천 0 | 조회 23
가을전어 2021.11.28 0 23
24093 기능/도구
New 작업표시줄 클릭으로 클립보드에 복사 문제 관련 (1)
어루 | 2021.11.28 | 추천 0 | 조회 21
어루 2021.11.28 0 21
24091 VBA
New 도와주세요! 뭐가 문제인지 못찾겠습니다.
y**** | 2021.11.28 | 추천 0 | 조회 40
y**** 2021.11.28 0 40
24089 VBA
New 엑셀 vlookup vba 문의드립니다. (4) 답변완료
ㅈㄱㄹ | 2021.11.28 | 추천 0 | 조회 45
ㅈㄱㄹ 2021.11.28 0 45
24088 함수/공식
New 개인별 회비 납부 현황에 따라 월별 납부액 결정 관련 함수 또는 VBA (미납, 매월 16일 이후 납부할 경우 월회비 10% 가산) 첨부파일 (5) 답변완료
007 | 2021.11.28 | 추천 0 | 조회 58
007 2021.11.28 0 58
24081 함수/공식
New 영문주소를 한글주소로 변경 희망합니다. (1)
루s cos 개인대행 | 2021.11.28 | 추천 0 | 조회 37
루s cos 개인대행 2021.11.28 0 37
24072 VBA
New 수식이 있는 데이터에서 매크로를 사용하여 다른시트에 결과값만 붙여넣고 싶습니다. 첨부파일 (6) 답변완료
호랑이파워 | 2021.11.28 | 추천 0 | 조회 57
호랑이파워 2021.11.28 0 57
24068 파워쿼리/피벗
New 파워쿼리 간단한 '값 바꾸기' 에 대해서 질문드립니다. 첨부파일 (3)
월마리아 | 2021.11.28 | 추천 0 | 조회 31
월마리아 2021.11.28 0 31
24065 피벗테이블
New 열과 행 바꾸는 쉬운 방법있나요? 첨부파일 (5) 답변완료
jyj6**** | 2021.11.27 | 추천 0 | 조회 55
jyj6**** 2021.11.27 0 55
24060 VBA
New 메모리가 부족하다고 뜹니다. 첨부파일
선물 | 2021.11.27 | 추천 0 | 조회 33
선물 2021.11.27 0 33
24059 VBA
New 첨부파일을 서버 업로드 (1)
권원재 | 2021.11.27 | 추천 0 | 조회 31
권원재 2021.11.27 0 31
24053 파워쿼리/피벗
엑셀 배열 순서를 바꾸고 싶습니다. 첨부파일
jyj6**** | 2021.11.27 | 추천 1 | 조회 36
jyj6**** 2021.11.27 1 36
VBA
Re:엑셀 배열 순서를 바꾸고 싶습니다.
Yukon | 2021.11.27 | 추천 1 | 조회 43
Yukon 2021.11.27 1 43
피벗테이블
New Re:Re:엑셀 배열 순서를 바꾸고 싶습니다. (1)
jyj6**** | 2021.11.27 | 추천 0 | 조회 28
jyj6**** 2021.11.27 0 28