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

 코알라 (sis0351)

추천:  2
파일:     조회:  1502
제목:   [RE]자동합계
     
  혹여 보시면
아래 코드로 적용하세요.

Private Sub Worksheet_Change(ByVal Target As Range)
 With Target
      If .Count > 1 Then Exit Sub
      Select Case .Column
             Case 18: .Offset(0, -17).Value = Date
             Case 6:  .Interior.Color = 65535
             Case 15: .Interior.Color = 62885
             Case 13
                       If Cells(.Row, 2) <> "" Then
                          Call calc(11, 13, .Row, 14)
                          Call calc(9, 13, .Row, 17)
                       End If
      End Select
 End With
 End Sub

 Function calc(s, e, R, c)
 Dim i    As Long
 Dim j    As Long
 Dim V()  As Variant
 On Error Resume Next
 ReDim V(s To 14)
 For i = s To e
     V(i) = Split(Cells(R, i), vbLf)
 Next i
 V(14) = Split(Cells(R, 2), vbLf)
 For i = 0 To UBound(V(14))
     V(14)(i) = 0
     For j = s To e
         V(14)(i) = V(14)(i) + Val(V(j)(i))
     Next j
 Next i
 Cells(R, c) = Join(V(14), vbLf)
 On Error GoTo 0
 End Function

 Sub SheetReset()
     With Columns("C:C").Interior
         .Pattern = xlNone
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
 End Sub
 
[불량 게시물 신고]  
        
  

작성일 : 2018-06-03(21:39)
최종수정일 : 2018-06-03(21:39)
 


 ◎ 관련글

  제 목   작성자   날짜
자동합계 실버라인 2018-06-02
[RE]자동합계 코알라 2018-06-02
[RE]자동합계 코알라 2018-06-03