none
현재 선택셀을 조건에 따라 한 행씩 올려서 선택할려고 합니다. RRS feed

  • 질문

  • 상담원 성명 별로 작업시간의 합계를 구할려고 하는데요

    만약 상담원의 작업시간 셀 중 하나를 선택 했을경우 선택셀 왼쪽에 있는 상담원 이름을 바로 위에 셀과 비교하여

    이름이 같으면 선택셀을 한 행 올려서 지정할려고 합니다.

    아래 코드에서 잘못된 부분이 어디인지 알려주세요..ㅠㅠ

    Sub 부분합()

        Dim Start As Range, Begin As Range
        Dim Name As String
        Dim Sum As Single
        Dim i As Integer, j As Integer
       
        Application.DisplayAlerts = False

       
            On Error Resume Next
           
            Set Start = Application.InputBox("병합을 시작할 셀을 지정해 주세요" & vbCr & _
                "선택하신 셀 오른쪽에 상담원의 총 근무시간이 표시됩니다.", "셀병합", Type:=8)
               
            If Intersect(Start, Range("d4:d32")) Is Nothing Then      
            
                MsgBox "작업시간 셀이 아닙니다" & vbCr & "셀을 다시 지정해주세요", vbOKOnly
                Range("d4").Select 
                
            Else            
            
                Name = Start.Offset(0, -1).Value
                                      
                Set Begin = Start.Offset(0, 1)
               
                If Name = Start.Offset(-1, -1) Then
               
                    j = 0
                              
                    Do While Name = Start.Offset(j - 1, -1).Value                
                        Set Start = Start.Offset(Start.Row - 1, 0)             
                            j = j - 1
                    Loop
                   
                Else
               
                i = 0
               
                Do While Name = Start.Offset(i + 1, -1)           
                    Sum = Sum + Start.Offset(i, 0)               
                    With Range(Begin, Start.Offset(i + 1, 1))                    
                        .Merge
                        .Borders.Weight = xlThin
                        .NumberFormat = "[HH]:mm:ss"
                        .horizontalaligment = xlCenter
                        .Range("a1") = Sum                    
                    End With
                   
                    i = i + 1
                   
                Loop
               
                End If
               
            End If       
                
                    Application.DisplayAlerts = True
                   
                   
                   
                   
               
               
               
               
               
               
           
              
               
               
    End Sub

    2015년 3월 6일 금요일 오전 10:12

모든 응답

  • 현재 문제되어지는 에러메시지나 해당 파일을 Test가능하도록 클라우드에 올려서 공유해주시면 감사하겠습니다.

    감사합니다.

    2015년 3월 9일 월요일 오전 5:24
    중재자