luhpro

§Úı±o³o­Ó Case ¤£¨Ï¥Î Dictionary ¤Ï¦Ó¥i¯à·|§ó§Ö©O, µ{¦¡¦p¤U :

Sub Ex()
    Dim i%, j%, iSou%, iRes%, Text$
    Dim rC As Range
   
    Sheets("Result").Range("A2:G65536").Clear
   
    iRes = 2
    With Sheets("Date")
      iSou = .Range("B65536").End(xlUp).Row
      
      For j = 2 To iSou
      ' ³oÃä­ì·Q­n®M¥Î Join ¤èªk¦ý·f°t Cells ¤@ª½³£»¡ "°õ¦æ¿ù»~", ©Ò¥H¥u¯à¼È®É¥ý³o¼Ë¥ÎÅo.
      Text = .Cells(j, 2) & "-" & .Cells(j, 3) & "-" & .Cells(j, 4) & "-" & .Cells(j, 5) & "-" & .Cells(j, 6)
               
        With Sheets("Result")
          Set rC = .Range(.Cells(2, 7), .Cells(iRes, 7)).Find(Text, LookIn:=xlValues)
         
          If Not rC Is Nothing Then
            i = rC.Row
            .Cells(i, 6) = .Cells(i, 6) + 1
          Else
            .Cells(iRes, 7) = Text
            .Cells(iRes, "A").Resize(, 5) = Split(Text, "-")
            .Cells(iRes, 6) = 1
            iRes = iRes + 1
          End If
        
        End With
      Next j
      
    End With
  Sheets("Result").Range("G2:G65536").Clear
End Sub