Re:한셀에 여러개의 레코드값을 찾아 나타내는 방법 질문입니다.

[Lago]

Sub Test()
     Dim rngD As Range, R  As Range
     Dim rngF As Range, F As Range
     Dim ad As String
     Dim c As Long, j As Long, i As Long, k As Long
     Dim myY As Integer
     Dim myM As Integer
     Dim xDate As Date
     Dim strX() As String
    
     With Sheets("일정")
          Set rngF = .Range("A1").EntireColumn.SpecialCells(2)
     End With
     c = 14
     With Sheets("달력")
          Set rngD = .Range("B7").Resize(1, c)
          Set rngD = Union(rngD, .Range("B9").Resize(1, c))
          Set rngD = Union(rngD, .Range("B11").Resize(1, c))
          Set rngD = Union(rngD, .Range("B13").Resize(1, c))
          Set rngD = Union(rngD, .Range("B15").Resize(1, c))
          Set rngD = Union(rngD, .Range("B17").Resize(1, c))
          rngD.ClearContents
          Set rngD = rngD.Offset(-1)
          myY = CInt(.[C2])
          myM = CInt(.[E2])
         
          On Error Resume Next
          With Application
               .ScreenUpdating = False
               .EnableEvents = False
          End With
          For i = 6 To 16 Step 2
               For k = 2 To 14 Step 2
                    Set R = .Cells(i, k)
                    If R.Value <> "" And CDate(R) Then
                         j = 0
                         Erase strX
                         xDate = DateSerial(myY, myM, Day(R))
                         Set F = rngF.Find(xDate, , xlFormulas, xlWhole)
                         If Not F Is Nothing Then
                              ad = F.Address
                              Do
                                   ReDim Preserve strX(j)
                                   strX(j) = F.Offset(, 1)
                                   j = j + 1
                                   Set F = rngF.FindNext(F)
                              Loop While Not F Is Nothing And ad <> F.Address
                              R.Offset(1).Resize(1, 2).Value = Join(strX, Chr(10))
                         End If
                    End If
               Next
          Next
          With Application
               .ScreenUpdating = True
               .EnableEvents = True
          End With
     End With
     Worksheets("달력").Range("R6:R23").NumberFormat = "d"

End Sub

코드를 이렇게 수정 하여 보세요..!!

[윤슬]

라고야 고마워...
내가 금주내내 교육이라 답변을 못 드렸는데... ^^*

[ITX청춘]

허걱!
코드 전혀 모르는데...
그대로 복사해서 실행했는데요 일자보다 하루 더 큰 일자에 나타나네요.
그리고 5주차 이상일때 빈셀에도 월초 data들이 나타납니다.ㅠㅠ
코드를 좀 알면 수정할텐데...

[Lago]

코드중에
xDate = DateSerial(myY, myM, Day(R))
를
xDate = DateSerial(myY, myM, CInt(R))
이렇게 수정하시면..

[ITX청춘]

1일 이전은 전월말의 data가 나타나고
말일 이후는 익월초의 data가 나타납니다.
요 부분 해결방법은 없을까요?
달력에서는 일자가 보이지 않도록 했습니다.
Clear하게 당월의 data만 보고 싶습니다.

[Lago]

하기 답글 확인해 보시면.....