Sub text()Dim i, j, num, row As IntegerDim arr() As IntegerFor i = 1 To 3000If Cells(i, 2) = "工号：" ThenReDim Preserve arr(num + 1)If i > 0 Thenarr(num) = iEnd Ifnum = num + 1End IfNextFor j = 0 To (UBound(arr) - 1)If j < UBound(arr) - 1 ThenFor k = 0 To (arr(j + 1) - arr(j) - 1)If Cells(arr(j), 19) = "销售部" Thenrow = row + 1For i = 2 To 31Rem Debug.Print arr(j) + k, i + 33Cells(row, i + 33) = Cells(arr(j) + k, i)Rem Cells(arr(j) + k, i + 33) = Cells(arr(j) + k, i)NextEnd IfNextEnd IfNextDebug.Print "DONE"End Sub