[已解决]排列

c888

谢谢！

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-1-15 14:25

Sub demo()

   Sheets("表1").Select: arr = Range("A1").CurrentRegion
   Sheets("表2").Select: Range("A1").CurrentRegion.Clear
   Columns("A:H").Select: Selection.NumberFormatLocal = "@"
   
   For i = 2 To UBound(arr, 1)
      If arr(i, 1) <> class Then
         class = arr(i, 1)
         r = r + 2
         Cells(r, 1).Value = arr(i, 1)
         r = r + 1
         Cells(r, 1).Value = "班主任": Cells(r, 2).Value = arr(i, 6)
         Cells(r + 1, 1).Value = "运动员"
       End If
   
      If arr(i, 5) <> gender Then
         gender = arr(i, 5)
         r = r + 2: c = 1
         Cells(r, 1).Value = arr(i, 5)
      End If
   
      If c = 8 Then c = 1: r = r + 2
      c = c + 1
      Cells(r, c).Value = arr(i, 2)
      Cells(r + 1, c).Value = arr(i, 3)
   Next
   Range("A2").Select
   
End Sub
祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

c888

请老师给个思路，谢谢！

c888

请老师给个指教。谢谢！

cutecpu

Sub demo()

   Sheets("表1").Select: arr = Range("A1").CurrentRegion
   Sheets("表2").Select: Range("A1").CurrentRegion.Clear
   Columns("A:H").Select: Selection.NumberFormatLocal = "@"
   
   For i = 2 To UBound(arr, 1)
      If arr(i, 1) <> class Then
         class = arr(i, 1)
         r = r + 2
         Cells(r, 1).Value = arr(i, 1)
         r = r + 1
         Cells(r, 1).Value = "班主任": Cells(r, 2).Value = arr(i, 6)
         Cells(r + 1, 1).Value = "运动员"
       End If
   
      If arr(i, 5) <> gender Then
         gender = arr(i, 5)
         r = r + 2: c = 1
         Cells(r, 1).Value = arr(i, 5)
      End If
   
      If c = 8 Then c = 1: r = r + 2
      c = c + 1
      Cells(r, c).Value = arr(i, 2)
      Cells(r + 1, c).Value = arr(i, 3)
   Next
   Range("A2").Select
   
End Sub
祝順心，南無阿彌陀佛！

c888

http://www.excelpx.com/forum.php ... &extra=page%3D1
老师请帮忙指教，与前次排列有点相似。谢谢！

gy7898

cutecpu 发表于 2021-1-15 14:25
Sub demo()

   Sheets("表1").Select: arr = Range("A1").CurrentRegion

学习了，学习了