[已解决]（求助）请老师看看能否修改一下改变数据的显示结果？

阿瑛

如附件 如何改变数据的显示结果？.rar (11.45 KB, 下载次数: 17)

2011-8-16 13:55 上传

点击文件名下载附件

如不好修改，重新写过也可以。

谢谢本坛所有热心老师！

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2011-8-16 15:48

1. Sub ss()
   
2. Dim aa1, c, col%, firstAddrtess$
   
3. aa1 = Array(24, 13, 32, 10)
   
4. Sheet2.Cells.ClearContents
   
5. With Sheet1.[a1].CurrentRegion
   
6. Set c = .Find(aa1(0), , , xlWhole)
   
7. If Not c Is Nothing Then
   
8.     firstAddress = c.Address
   
9.     Do
   
10.         If c.Offset(1, 0) = aa1(1) And c.Offset(2, 0) = aa1(2) And c.Offset(3, 0) = aa1(3) Then
    
11.             col = col + 1
    
12.             If c.Row = 1 Then
    
13.                 c.Offset(-1, 0).Resize(5, 1).Copy Sheet2.Cells(2, col)
    
14.             ElseIf c.Offset(3, 0).Row = Sheet1.[a1].CurrentRegion.Rows.Count Then
    
15.                 c.Offset(-1, 0).Resize(5, 1).Copy Sheet2.Cells(1, col)
    
16.             Else
    
17.                 c.Offset(-1, 0).Resize(6, 1).Copy Sheet2.Cells(1, col)
    
18.             End If
    
19.          End If
    
20.          Set c = .FindNext(c)
    
21.      Loop While Not c Is Nothing And c.Address <> firstAddress
    
22. End If
    
23. End With
    
24. End Sub
    

复制代码

跳转到最佳答案楼层

biszwack

表我看了，是是真的没明白你要做什么

阿瑛

在SHEET2里，A列显示的是原代码查询的结果，如C2-C5，表明查询到的四个数在这个位置。
因为这种结果只是标明了数据所在位置，而不是真正的数据，所以想改一下，直接把查询到的结果显示为数据。想查询哪四个数，可以在代码中输入四个数据。

蓝桥玄霜

1. Sub ss()
   
2. Dim aa1, c, col%, firstAddrtess$
   
3. aa1 = Array(24, 13, 32, 10)
   
4. Sheet2.Cells.ClearContents
   
5. With Sheet1.[a1].CurrentRegion
   
6. Set c = .Find(aa1(0), , , xlWhole)
   
7. If Not c Is Nothing Then
   
8.     firstAddress = c.Address
   
9.     Do
   
10.         If c.Offset(1, 0) = aa1(1) And c.Offset(2, 0) = aa1(2) And c.Offset(3, 0) = aa1(3) Then
    
11.             col = col + 1
    
12.             If c.Row = 1 Then
    
13.                 c.Offset(-1, 0).Resize(5, 1).Copy Sheet2.Cells(2, col)
    
14.             ElseIf c.Offset(3, 0).Row = Sheet1.[a1].CurrentRegion.Rows.Count Then
    
15.                 c.Offset(-1, 0).Resize(5, 1).Copy Sheet2.Cells(1, col)
    
16.             Else
    
17.                 c.Offset(-1, 0).Resize(6, 1).Copy Sheet2.Cells(1, col)
    
18.             End If
    
19.          End If
    
20.          Set c = .FindNext(c)
    
21.      Loop While Not c Is Nothing And c.Address <> firstAddress
    
22. End If
    
23. End With
    
24. End Sub
    

复制代码