非常感谢lzyamo3057老师帮处理下C列数据在B列数据的位置问题，谢谢！

abcttud

麻烦lzyamo3057老师帮处理下C列数据在B列数据的位置问题，谢谢！


麻烦lzyamo3057老师帮处理下C列数据在B列数据的位置问题，谢谢！.rar (11.28 KB, 下载次数: 28)

2013-4-24 10:51 上传

点击文件名下载附件

lzyamo3057

首先先说下，千万别这样叫我。我也是一个初学者。只是不怕被人笑，再说，论坛里的老师们都不会笑话，即使代码很差。

lzyamo3057

1. Sub test()
   
2.     Dim arr, d, i, brr()
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("第一个问题").Range("a1").CurrentRegion
   
5.     For i = 1 To UBound(arr)
   
6.         d(Val(Right(Val(Cells(i, 3)), 6))) = arr(i, 1)
   
7.     Next
   
8.     For i = 1 To UBound(arr)
   
9.         k = k + 1
   
10.         ReDim Preserve brr(1 To k)
    
11.         If d.exists(arr(i, 2)) Then
    
12.             brr(k) = d(arr(i, 2))
    
13.         End If
    
14.     Next
    
15.     Sheets("第一个问题").Range("d1:d10000").ClearContents
    
16.     Sheets("第一个问题").Range("d1").Resize(UBound(brr)) = Application.WorksheetFunction.Transpose(brr)
    
17.     Set d = Nothing
    
18. End Sub
    
19. 
    

复制代码

abcttud

lzyamo3057 发表于 2013-4-24 11:40

谢谢老师！还有两列中数据找不到对应的，改变颜色怎么处理。

lzyamo3057

abcttud 发表于 2013-4-24 12:07
谢谢老师！还有两列中数据找不到对应的，改变颜色怎么处理。

要求没有变化，只是当时的列与现在的列变化下？

abcttud

老师测试好象有问题。

1        179521        320000500000332         
2        70809        320000000053346          8
3        53346        320000000054425          2
4        332        320000000057340          1
5        187476        320000000079521          6
6        145016        320000000187476          11
7        65309        320102000065309          7
8        65016        320102000070809         
9        57340        320103000038343          4
10        54425        320103000045016          3
11        38343        320103000145016          9

lzyamo3057

可能是我理解错误了吧。打个比方，你的意思53346，对应的是3，所以在320000000053346，后面跟着应当是3？

abcttud

是的，谢谢老师！

lzyamo3057

1. Sub test()
   
2.     Dim arr, d, i, brr(), s
   
3.     Set d = CreateObject("scripting.dictionary")    '创建字典
   
4.     arr = Sheets("第一个问题").Range("a1").CurrentRegion   '将表1中A1起的连续单元格区域载入数组arr
   
5.     For i = 1 To UBound(arr)
   
6.         d(arr(i, 2)) = arr(i, 1)
   
7.     Next
   
8.     For i = 1 To UBound(arr)
   
9.     s = Val(Right(Val(Cells(i, 3)), 6))
   
10.         k = k + 1
    
11.         ReDim Preserve brr(1 To k)
    
12.         If d.exists(s) Then
    
13.             brr(k) = d(s)
    
14.         End If
    
15.     Next
    
16.     Sheets("第一个问题").Range("d1:d10000").ClearContents
    
17.     Sheets("第一个问题").Range("d1").Resize(UBound(brr)) = Application.WorksheetFunction.Transpose(brr)
    
18.     Set d = Nothing
    
19. End Sub
    
20. 
    

复制代码

abcttud

老师还有个按钮能实行随屏滚动吗
因为存在上千行数据，如有一些数据发生错误后，必须返回到前面去按按钮，如能滚动始终在可视屏幕上，就随时可单击了。老师这一功能能实现吗？