大神求助，如果用宏实现判断区域并做移动

-__shadow

问题如图所示，附件有表格，求助各位大神

CC例例

1. Sub Test()
   
2.     Dim c As Range, x%
   
3.     x = 7
   
4.     For Each c In Range("a1", Cells(Rows.Count, 1).End(3))
   
5.         If Trim(c) <> "" And Trim(c.Offset(, 1)) = "" Then
   
6.             c.CurrentRegion.Copy Cells(1, x)
   
7.             x = x + 4
   
8.         End If
   
9.     Next
   
10. End Sub

复制代码

CC例例

>>>>>>>>>>>>>>>>>

-__shadow

CC例例 发表于 2016-10-10 13:26
>>>>>>>>>>>>>>>>>

如果大写一和数字之间空出一行，又该怎么改呢

未忘初心

-__shadow 发表于 2016-10-10 13:43
如果大写一和数字之间空出一行，又该怎么改呢

1. Sub Test1()
   
2.     Dim rng As Range, icol%, i%, irow%, 空行数量%
   
3.     空行数量 = 1
   
4.     For Each rng In Range("A:A").SpecialCells(xlCellTypeConstants, xlTextValues)
   
5.         icol = rng.CurrentRegion.Columns.Count
   
6.         irow = rng.CurrentRegion.Rows.Count
   
7.         i = i + 1
   
8.         rng.Resize(1, icol).Copy Cells(1, icol * i + 3)
   
9.         rng.Offset(0, 1).Copy Cells(2, icol * i + 3).Resize(空行数量, icol)
   
10.         rng.Offset(1, 0).Resize(irow - 1, icol).Copy Cells(2 + 空行数量, icol * i + 3)
    
11.     Next
    
12. End Sub
    

复制代码

-__shadow

未忘初心 发表于 2016-10-10 14:35

实践过程中发生错误

CC例例

1. Sub Test()
   
2.     Dim c As Range, r As Range, i%, x%, y%
   
3.     i = 7
   
4.     For Each c In Range("a1", Cells(Rows.Count, 1).End(3))
   
5.         If Trim(c) <> "" Then
   
6.             If Asc(c) < 0 Then
   
7.             x = c.Offset(2).CurrentRegion.Rows.Count + 2
   
8.             y = c.Offset(2).CurrentRegion.Columns.Count
   
9.             Set r = IIf(Trim(c.Offset(1)) = "", c.Resize(x, y), c.CurrentRegion)
   
10.             r.Copy Cells(1, i)
    
11.             i = i + 4
    
12.             End If
    
13.         End If
    
14.     Next
    
15.     Set r = Nothing
    
16. End Sub

复制代码

CC例例

>>>>>>>>>>>>>>>>>

-__shadow

CC例例 发表于 2016-10-10 14:47
>>>>>>>>>>>>>>>>>

大神，我下面的数字部分换成文本加数字后，宏运行后会无限复制。

-__shadow

CC例例 发表于 2016-10-10 14:47
>>>>>>>>>>>>>>>>>

实际表格5列的话，代码需要有所变动么