[已解决]编排

c888

数据排列，谢谢老师指教！

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-1-18 19:51

Sub demo()

   Sheets("數據").Select: arr = Range("A1").CurrentRegion
   Sheets("編排").Select: Range("A1").CurrentRegion.Clear
   Columns("A:G").Select: Selection.NumberFormatLocal = "@"
   r = -3
   For i = 2 To UBound(arr, 1)
      If arr(i, 2) <> class Or arr(i, 3) <> gender Or arr(i, 4) <> Item Or arr(i, 5) <> race Then
         class = arr(i, 2): gender = arr(i, 3): Item = arr(i, 4): race = arr(i, 5): Group = ""
         r = r + 5
         Cells(r, 1).Value = class & gender & Item & race
         r = r - 4
      End If

      If arr(i, 6) <> Group Then
         Group = arr(i, 6)
         r = r + 5: c = 1
         Cells(r, 1) = Group
         r = r + 1
      End If

      If c = 7 Then c = 1: r = r + 5
      If c = 1 Then
         Cells(r + 0, 1) = "道次"
         Cells(r + 1, 1) = "號碼"
         Cells(r + 2, 1) = "姓名"
         Cells(r + 3, 1) = "班級"
         Cells(r + 4, 1) = "備註"
      End If

      c = c + 1
      Cells(r + 0, c) = arr(i, 7)
      Cells(r + 1, c) = arr(i, 8)
      Cells(r + 2, c) = arr(i, 9)
      Cells(r + 3, c) = arr(i, 10)

   Next
   Range("A2").Select

End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

gy7898

http://www.excelpx.com/forum.php ... &extra=page%3D1
cutecpu家的麦子

cutecpu

Sub demo()

   Sheets("數據").Select: arr = Range("A1").CurrentRegion
   Sheets("編排").Select: Range("A1").CurrentRegion.Clear
   Columns("A:G").Select: Selection.NumberFormatLocal = "@"
   r = -3
   For i = 2 To UBound(arr, 1)
      If arr(i, 2) <> class Or arr(i, 3) <> gender Or arr(i, 4) <> Item Or arr(i, 5) <> race Then
         class = arr(i, 2): gender = arr(i, 3): Item = arr(i, 4): race = arr(i, 5): Group = ""
         r = r + 5
         Cells(r, 1).Value = class & gender & Item & race
         r = r - 4
      End If

      If arr(i, 6) <> Group Then
         Group = arr(i, 6)
         r = r + 5: c = 1
         Cells(r, 1) = Group
         r = r + 1
      End If

      If c = 7 Then c = 1: r = r + 5
      If c = 1 Then
         Cells(r + 0, 1) = "道次"
         Cells(r + 1, 1) = "號碼"
         Cells(r + 2, 1) = "姓名"
         Cells(r + 3, 1) = "班級"
         Cells(r + 4, 1) = "備註"
      End If

      c = c + 1
      Cells(r + 0, c) = arr(i, 7)
      Cells(r + 1, c) = arr(i, 8)
      Cells(r + 2, c) = arr(i, 9)
      Cells(r + 3, c) = arr(i, 10)

   Next
   Range("A2").Select

End Sub

祝順心，南無阿彌陀佛！

gy7898

cutecpu 发表于 2021-1-18 19:51
Sub demo()

   Sheets("數據").Select: arr = Range("A1").CurrentRegion

学习了学习了，清晰的思路，精练的表达

c888

cutecpu 发表于 2021-1-18 19:51
Sub demo()

   Sheets("數據").Select: arr = Range("A1").CurrentRegion

谢谢您老师！就是要这个效果！