팁&서식

기부금영수증

요청에 의해 만들어본 기부금 영수증...

일련번호 , 성명, 주민번호, 금전합계, 현물 합계를 입력하면 등록장부 시트에 순서대로 등록됩니다.

일련번호가 중복되면 등록을 취소하거나 덮어쓰기할수 있습니다.


가져오기 단추를 누르면  성명에 기록된 기부내용이 나타납니다.

 1. 등록장부 시트에 같은 이름이 있으면 등록장부 시트의 기부내용이 나타납니다.

 2. 등록장부 시트에 가까이 있는 시트의 기부내용이 나타납니다.

 3. 동명 이인은 판별하지 않습니다.


Sub 장부추가()

cnt = 0
Do
cnt = cnt + 1
If Worksheets("등록장부").Cells(cnt, 1) = Worksheets("기부금영수증").Range("b3") Then
  If MsgBox("중복된 일련번호가 존재합니다." & vbCrLf & "덮어쓸까요?", vbYesNo, "일련번호중복") = vbYes Then
    Exit Do
  Else
    Exit Sub
  End If
  Exit Sub
End If
Loop Until Worksheets("등록장부").Cells(cnt, 1) = ""

With Worksheets("등록장부")
 .Cells(cnt, 1) = Worksheets("기부금영수증").Range("b3")
 .Cells(cnt, 2) = Worksheets("기부금영수증").Range("c6")
 .Cells(cnt, 3) = Worksheets("기부금영수증").Range("n6")
 .Cells(cnt, 4) = Worksheets("기부금영수증").Range("c8")
 .Cells(cnt, 5) = Worksheets("기부금영수증").Range("m25")
 .Cells(cnt, 7) = Worksheets("기부금영수증").Range("m26")
End With
End Sub
Sub 가져오기()
cnt = 0
For Each sht장부 In Worksheets
     i = 0
  With Worksheets(sht장부.Name)
    Do
    i = i + 1
    If .Cells(i, 1) = "" Then Exit Do
    If .Cells(i, 2) = Worksheets("기부금영수증").Range("c6") Then
       MsgBox .Name
       Worksheets("기부금영수증").Range("b3") = .Cells(i, 1)
       Worksheets("기부금영수증").Range("c6") = .Cells(i, 2)
       Worksheets("기부금영수증").Range("n6") = .Cells(i, 3)
       Worksheets("기부금영수증").Range("c8") = .Cells(i, 4)
       Worksheets("기부금영수증").Range("m25") = .Cells(i, 5)
       Worksheets("기부금영수증").Range("m26") = .Cells(i, 7)
       Exit Sub
     End If
    
    Loop
  End With
Next
MsgBox cnt
End Sub

.

Comments