|
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
첨부된 파일처럼 서식을 만들고 싶습니다.
힘드시겠지만 고수님들의 도움바랍니다...
==============[카스님 글에 대한 답변입니다]==============
첨부파일을 참고하세요.
Sub CreateSheet()
Dim sht As Worksheet, shtForm As Worksheet, shtX As Worksheet
Dim rTable As Range, rRow As Range
Dim rFind As Range
Dim datEnd As Date
Set sht = Worksheets("신청")
Set rTable = sht.[A5].CurrentRegion
Set rTable = rTable.Offset(2).Resize(rTable.Rows.Count - 2)
For Each rRow In rTable.Rows
Set shtX = getSheet(rRow.Cells(1, 1))
datEnd = DateSerial(Mid(rRow.Cells(1, 4), 1, 4), Mid(rRow.Cells(1, 4), 5, 2), Mid(rRow.Cells(1, 4), 7, 2))
If datEnd <= Date Then ' 종료된 자료만 Update 함
Set rFind = shtX.UsedRange.Find(rRow.Cells(1, 2).Value, LookAt:=xlWhole)
If Not rFind Is Nothing Then
If rFind.Cells(1, 2) <= rRow.Cells(1, 3) Or rFind.Cells(1, 3) <= rRow.Cells(1, 4) Then
rFind.Cells(1, 2).Resize(1, 3) = rRow.Cells(1, 3).Resize(1, 3).Value
Else
rFind.Cells(1, 4) = "신청일자를 확인하세요."
End If
Else
rRow.Cells(1, rRow.Columns.Count + 3) = "Err : 자료확인요망"
End If
Else
rRow.Cells(1, rRow.Columns.Count + 3) = "Pass : 종료됨"
End If
Next
End Sub
Function getSheet(sName As String)
Dim shtX As Worksheet
Set shtX = ActiveSheet
On Error Resume Next
Set getSheet = Worksheets(sName)
If Err.Number <> 0 Then
Form.Visible = xlSheetVisible
Form.Copy Before:=Form
Set getSheet = ActiveSheet
getSheet.Name = sName
getSheet.[A1] = sName
Form.Visible = xlSheetVeryHidden
End If
On Error GoTo 0
shtX.Activate
End Function
|
|