개발 요청] 치수 변경, 간섭 체크, 최단 거리 값 구하기 #1 -개발 중

□치수 값을 조합하는 배열 만들기

Sub GenerateAllCombinations()
    Dim oCol() As Collection
    Dim rngSel As Range
    Dim totalComb As Long
    Dim resultArray() As Variant ' 결과를 저장할 배열

    ' 현재 선택한 영역을 범위로 설정
    Set rngSel = Worksheets("FingerCheck").Range("B6", "G8")
    totalComb = 1
    
    ' 데이터를 컬렉션에 저장하고 총 조합 수 계산
    InitializeCollections rngSel, oCol, totalComb

    ' 결과 배열 생성 및 조합 저장
    resultArray = GenerateCombinationsToArray(oCol, rngSel.Columns.Count, totalComb)
    
End Sub

'// 데이터를 컬렉션에 저장하고 총 조합 수를 계산하는 서브루틴
Private Sub InitializeCollections(rngSel As Range, oCol() As Collection, ByRef totalComb As Long)
    Dim i As Long, j As Long
    
    For j = 1 To rngSel.Columns.Count
        ReDim Preserve oCol(1 To rngSel.Columns.Count) ' 배열 크기 동적 설정
        Set oCol(j) = New Collection                   ' Collection 초기화
        
        For i = 1 To rngSel.Rows.Count
            If Not IsEmpty(rngSel.Cells(i, j)) Then
                oCol(j).Add rngSel.Cells(i, j).Value   ' 값을 Collection에 추가
            End If
        Next i
        totalComb = totalComb * oCol(j).Count          ' 조합 수 계산
    Next j
End Sub

'// 모든 조합을 배열에 저장하는 함수
Private Function GenerateCombinationsToArray(oCol() As Collection, colCount As Long, totalComb As Long) As Variant
    Dim resultArray() As Variant
    Dim crit As Double
    Dim j As Long, k As Long, m As Long
    Dim rowIndex As Long

    ' 결과 배열 초기화
    ReDim resultArray(1 To totalComb, 1 To colCount)
    crit = totalComb

    rowIndex = 1 ' 배열의 행 인덱스

    For j = 1 To colCount
        For m = 1 To totalComb / crit
            For k = 1 To crit
                resultArray(rowIndex, j) = oCol(j)(1 + Int((k - 1) / (crit / oCol(j).Count)))
                rowIndex = rowIndex + 1
            Next k
        Next m
        crit = crit / oCol(j).Count
        rowIndex = 1 ' 다음 열 작업 시 초기화
    Next j

    GenerateCombinationsToArray = resultArray
End Function

 

 

by korealionkk@gmail.com

---