quickfixer

¦^´_ 1# m06o2

1. Sub test()
   
2.    
   
3. Dim LastRow As Long
   
4. Sheets("¤u§@ªí2").Cells.Clear
   
5. With Sheets("¤u§@ªí1")
   
6.     LastRow = .Range("A1").CurrentRegion.Rows.Count
   
7.     rr = 1
   
8.     cc = 1
   
9.     For i = 1 To LastRow
   
10.         Sheets("¤u§@ªí2").Cells(rr, cc) = .Cells(i, 1)
    
11.         If i = LastRow Then Exit For
    
12.         rr = rr + 1
    
13.         If Sgn(0 - .Cells(i, 1)) + Sgn(0 - .Cells(i + 1, 1)) = 0 Then
    
14.             aa = aa + 1
    
15.             If aa Mod 2 = 1 Then
    
16.             rr = 1
    
17.             cc = cc + 1
    
18.             End If
    
19.         End If
    
20.     Next i
    
21. 
    
22. End With
    
23. 
    
24. End Sub

½Æ»s¥N½X

¤U¸ü (39.23 KB)

2024-8-15 07:22