|
发表于 2011-8-16 15:48
|
显示全部楼层
本楼为最佳答案
- Sub ss()
- Dim aa1, c, col%, firstAddrtess$
- aa1 = Array(24, 13, 32, 10)
- Sheet2.Cells.ClearContents
- With Sheet1.[a1].CurrentRegion
- Set c = .Find(aa1(0), , , xlWhole)
- If Not c Is Nothing Then
- firstAddress = c.Address
- Do
- If c.Offset(1, 0) = aa1(1) And c.Offset(2, 0) = aa1(2) And c.Offset(3, 0) = aa1(3) Then
- col = col + 1
- If c.Row = 1 Then
- c.Offset(-1, 0).Resize(5, 1).Copy Sheet2.Cells(2, col)
- ElseIf c.Offset(3, 0).Row = Sheet1.[a1].CurrentRegion.Rows.Count Then
- c.Offset(-1, 0).Resize(5, 1).Copy Sheet2.Cells(1, col)
- Else
- c.Offset(-1, 0).Resize(6, 1).Copy Sheet2.Cells(1, col)
- End If
- End If
- Set c = .FindNext(c)
- Loop While Not c Is Nothing And c.Address <> firstAddress
- End If
- End With
- End Sub
复制代码 |
评分
-
查看全部评分
|