나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내
작성자:  

 dew (dewdrop)

추천:  2
파일:     박스 수량_집계_Ans.xlsm (27.6KB) 조회:  1768
제목:   [RE]공장 포장 박스별 수량 집계 질문드립니다.
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(95,97,2000,xp,2003,2007):

* 아래줄에 질문을 작성하세요 >>

공장마다 취급하는 품목들이 있는데 규격은 동일합니다.

따라서 500개가 1상자인데 품목마다 1상자 포장에 필요한 수량 만큼씩

분류되는 엑셀 시트를 만들려고 합니다. 

일단 임으로 보고 싶은 결과 값을 시트로 만들었습니다.

아무리 생각해봐도 마땅히 떠오르지 않네요.

도움 부탁드립니다.

==============[하나마루님 글에 대한 답변입니다]==============

첨부화일 참고하세요....

Sub getBoxCount()
    Dim rTable As Range, rX As Range
    Dim colX As New Collection, vX
    Dim rFind As Range, sAddr As String
    
    Dim lTot As Long, lTemp As Long
    Dim iCol As Integer, iX As Integer, iRept As Integer
    
    Set rTable = ActiveSheet.Range("A4")
    Set rTable = Range(rTable, rTable.End(xlDown))
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    For Each rX In rTable
        colX.Add rX.Value, rX.Value
    Next
    On Error GoTo 0
    
    For Each vX In colX
        iCol = 3
        Set rFind = rTable.EntireColumn.Find(vX, LookAt:=xlWhole)
        If Not rFind Is Nothing Then
            sAddr = rFind.Address
            lTemp = 0
            Do
                lTot = rFind.Cells(1, 3)
                
                iRept = Int(lTot / 500)
                For iX = 1 To iRept
                    iCol = iCol + IIf(lTemp = 0, 1, 0)
                        
                    rFind.Cells(1, iCol) = (500 - lTemp)
                    lTot = lTot - (500 - lTemp)
                    lTemp = 0
                Next
                If lTot > 0 Then
                    iCol = iCol + 1
                    rFind.Cells(1, iCol) = lTot
                    lTemp = lTot
                End If
                
                Set rFind = rTable.EntireColumn.FindNext(rFind)
            Loop While Not rFind Is Nothing And rFind.Address <> sAddr
        End If
    Next

    Application.ScreenUpdating = False
End Sub

 
[불량 게시물 신고]  
        
  

작성일 : 2019-09-30(17:10)
최종수정일 : 2019-09-30(17:10)
 


 ◎ 관련글

  제 목   작성자   날짜
공장 포장 박스별 수량 집계 질문드립니다. 하나마루 2019-09-29
[RE]공장 포장 박스별 수량 집계 질문드립니다. dew 2019-09-30
[RE]공장 포장 박스별 수량 집계 질문드립니다. 하나마루 2019-09-30