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

 dew (dewdrop)

추천:  2
파일:     예제1(10)_Ans.xlsm (23.8KB) 조회:  1420
제목:   [RE]자료만들기
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

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

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

날짜(30,31일까지 있음)별로 이름을 한셀에 표기하고, 장소별로 시트를 만들수 있을까요?
==============[카스님 글에 대한 답변입니다]==============

첨부파일 참고하세요..

Sub CreateEachSheet()
    Dim sht As Worksheet, shtTmp As Worksheet
    Dim rData As Range, rRow As Range
    Dim rFind As Range, rTg As Range
    Dim sAddr As String
    Dim bFlg As Boolean
    
    Set sht = ActiveSheet
    Set rData = sht.Range("A1").CurrentRegion
    
    For Each rRow In rData.Offset(1).Resize(rData.Rows.Count - 1).Rows
        Set shtTmp = getSheet(rRow.Cells(1, 3))
        If shtTmp.Cells(1, 1) = "" Then
            rData.Rows(1).Copy shtTmp.Cells(1)
        End If
        
        bFlg = False
        Set rFind = shtTmp.Columns(1).Find(What:=rRow.Cells(1, 1), LookAt:=xlWhole)
        If Not rFind Is Nothing Then
            If InStr(rFind.Cells(1, 2), rRow.Cells(1, 2)) > 0 Then
            Else
                rFind.Cells(1, 2) = rFind.Cells(1, 2) & "," & rRow.Cells(1, 2)
            End If
        Else
            Set rTg = shtTmp.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            rRow.Copy rTg
        End If
    Next
End Sub

Function getSheet(SheetName As String)
    Dim shtX As Worksheet
    
    On Error Resume Next
    Set getSheet = ThisWorkbook.Sheets(SheetName)
    If Err.Number <> 0 Then
        ThisWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
        Set getSheet = ActiveSheet
        getSheet.Name = SheetName
    End If
    On Error GoTo 0
End Function

 
[불량 게시물 신고]  
카스답변 고맙습니다.. 서식을 수정해서 파일을 다시 올려봅니다. 다시 한 번 답변 부탁드립니다.07-19 (14:28)
삭제 ■신고
        
  

작성일 : 2019-07-18(16:58)
최종수정일 : 2019-07-18(16:58)
 


 ◎ 관련글

  제 목   작성자   날짜
자료만들기 카스 2019-07-18
Dictionary+ArrayyList로 구분하여 처리 참서리 2019-07-18
[RE]자료만들기 dew 2019-07-18