求高手解救双循环，我写的变成死循环

tock357

Sub 理科成绩对比()

Dim I As Integer
Dim H As Integer



Sheets("理科成绩本表").Select
Z = Application.WorksheetFunction.CountA(Range("A:A"))

For H = 2 To Z
For I = 0 To Z - 2

Range(Cells(H, 1), Cells(H, 9)).Select
Selection.Copy



Sheets("理科成绩对比总表").Select
Range("A" & 2 + I * 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Next
Next


End Sub

tock357

此为成绩对比表的附件

liuxi001

这是要干嘛，真费解

tock357

liuxi001 发表于 2019-4-8 19:16
这是要干嘛，真费解

是要对比同一人不同场考试的成绩，我的第一个步骤是把本表的每个人按间隔4行分别复制到总表，第二步是按总表的每个人去引用被对比表的数据。但我第一步双循环就卡壳了！

Chip_Kenny

猜一個:

1. Sub zz()
   
2. Dim a, b(), i&, j&, n&
   
3. a = Sheets(1).[a1].CurrentRegion.Value
   
4. i = (UBound(a) - 1) * 5
   
5. ReDim b(1 To i, 1 To UBound(a, 2))
   
6. For i = 2 To UBound(a)
   
7.     n = (i - 2) * 5 + 1
   
8.     For j = 1 To UBound(a, 2)
   
9.         b(n, j) = a(i, j)
   
10.     Next
    
11. Next
    
12. With Sheets(6)
    
13.     .[a1].Resize(1, j - 1) = a
    
14.     .[a2].Resize(UBound(b), UBound(b, 2)) = b
    
15. End With
    
16. End Sub

复制代码

tock357

Chip_Kenny 发表于 2019-4-8 19:39
猜一個:

对。。。。。高手就是高手。。。。真厉害。。。我得慢慢消化您的大招！