******如何实现每个人每天的考勤记录，合并到同一个单元格？*****

yu88

工作簿2.zip (9.72 KB, 下载次数: 10)

2018-9-1 15:39 上传

点击文件名下载附件

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, k, n
  arr = Sheets("sheet1").[a1].CurrentRegion
  arr = Sheets("sheet1").[a1].Resize(UBound(arr, 1) + 1, UBound(arr, 2))
  ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2)) As String
  arr(UBound(arr, 1), 2) = "工号"
  For i = 1 To UBound(arr, 1)
    If i = UBound(arr, 1) Then Exit For
    If InStr(arr(i, 2), "工号") Then
      n = n + 3
      For j = 2 To UBound(arr, 2)
        brr(n - 2, j) = arr(i, j)
        brr(n - 1, j) = arr(i + 1, j)
      Next
      For j = 2 To UBound(arr, 2)
        For k = i + 2 To UBound(arr, 1) - 1
          If InStr(arr(k, 2), "工号") Then Exit For
          If Len(arr(k, j)) Then
            brr(n, j) = brr(n, j) & vbNewLine & arr(k, j)
          End If
        Next
        If Len(brr(n, j)) Then brr(n, j) = Mid(brr(n, j), 3)
      Next
      i = k - 1
    End If
  Next
  With Sheets("效果").[a1]
    .Resize(Rows.Count, UBound(brr, 2)).ClearContents
    .Resize(n, UBound(brr, 2)) = brr
  End With
End Sub