Sub datainsert() Dim r1 As Integer, r2 As Integer, i As Integer, j As Integer, findrow As Integer, findMonth As Integer, tday As Integer findMonth = Range("h1") Set Source = Worksheets("总周课表") Set t = ActiveSheet r1 = Source.Range("a65536").End(xlUp).Row '开始循环 For i = 2 To r1 xm = Source.Cells(i, 8) kc = Source.Cells(i, 7) jc = Source.Cells(i, 6) rq = Source.Cells(i, 4) bc = Source.Cells(i, 3) dd = Source.Cells(i, 9) '比较日期 If Format(rq, "M") = findMonth Then r2 = t.Range("c65536").End(xlUp).Row If (r2 < 3) Then r2 = 3 tday = Format(rq, "d") + 7 '后移7个单元格 findrow = 0 For j = 3 To r2 If t.Cells(j, 3) = xm Then findrow = j Exit For End If Next If (findrow > 0) Then '找到 t.Cells(findrow, tday) = Cells(findrow, tday) & " " & jc Else '没找到直接添加 t.Cells(r2 + 1, 3) = xm t.Cells(r2 + 1, 4) = kc t.Cells(r2 + 1, 6) = bc t.Cells(r2 + 1, 39) = dd t.Cells(r2 + 1, tday) = jc End If End If Next End Sub