[已解决]移动位置问题

fangniuji

hwc2ycy 发表于 2012-12-19 11:02
晚上再帮你改哈。

谢谢，谢谢！！！！

hwc2ycy

1. Option Explicit
   
2. Sub 移位3()
   
3.     '2012-12-19 hwc2ycy 修改
   
4.     Dim str1$, str2$, str3$
   
5.     Dim pos1&, pos2&, pos3&
   
6.     Dim i&, i3&
   
7.         
   
8.     str1 = UCase(Range("g2"))
   
9.     str2 = UCase(Range("h2"))
   
10.     str3 = UCase(Range("i2"))
    
11.     On Error Resume Next
    
12.     ' 数据的局限性，必须以非数字开始，其后必须是数字
    
13.     If Len(str2) = 0 Then MsgBox "H2单元格无数据": Exit Sub
    
14.     If Len(str1) > 2 Then str1 = Left(str1, 1) & Right(str1, Len(str1) - 1) * 1
    
15.     If Len(str2) > 2 Then str2 = Left(str2, 1) & Right(str2, Len(str2) - 1) * 1
    
16.     If Len(str3) > 2 Then str3 = Left(str3, 1) & Right(str3, Len(str3) - 1) * 1
    
17. 
    
18.    
    
19.     If Len(str1) > 0 Then
    
20.         pos2 = Range("a:a").Find(str2, , , xlWhole).Row
    
21.         If Err.Number <> 0 Then MsgBox "H2数据无法找到": Exit Sub
    
22. 
    
23.         pos1 = Range("a:a").Find(str1, , , xlWhole).Row
    
24.         If Err.Number <> 0 Then MsgBox "G2数据无法找到": Exit Sub
    
25. 
    
26.         i = pos1 + 1
    
27.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Len(Cells(i, 1)) = 0 Or Cells(i, 1) Like "%" Or Cells(i, 1) Like "M30"
    
28.             i = i + 1
    
29.         Loop
    
30.         
    
31.         Application.ScreenUpdating = False
    
32.         'G2置前
    
33.         If pos2 <> i Then
    
34.             Range("a" & pos1 & ":a" & i - 1).Cut
    
35.             Range("a" & pos2).Insert xlShiftDown
    
36.         End If
    
37.         Application.ScreenUpdating = True
    
38.     End If
    
39.         
    
40.     If Len(str3) > 0 Then
    
41.         pos3 = Range("a:a").Find(str3, , , xlWhole).Row
    
42.         If Err.Number <> 0 Then MsgBox "I2数据无法找到": Exit Sub
    
43.         '取后置行
    
44.         i = pos3 + 1
    
45.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Cells(i, 1) Like "M30" Or Cells(i, 1) Like "%"
    
46.             i = i + 1
    
47.         Loop
    
48.         i3 = i - 1
    
49.         
    
50.         '中间行
    
51.         pos2 = Range("a:a").Find(str2, , , xlWhole).Row
    
52.         If Err.Number <> 0 Then MsgBox "H2数据无法找到": Exit Sub
    
53.         i = pos2 + 1
    
54.         Do Until Cells(i, 1) Like "T??" Or Cells(i, 1) Like "T?" Or Len(Cells(i, 1)) = 0 Or Cells(i, 1) Like "%" Or Cells(i, 1) Like "M30"
    
55.             i = i + 1
    
56.         Loop
    
57.         
    
58.         Application.ScreenUpdating = False
    
59.         If i <> pos3 Then
    
60.             Range("a" & pos3 & ":a" & i3).Cut
    
61.             Range("a" & i).Insert xlShiftDown
    
62.         End If
    
63.         Application.ScreenUpdating = True
    
64.     End If
    
65. End Sub

复制代码

hwc2ycy

原来的答案确实没考虑这个，有不少BUG。

fangniuji

hwc2ycy 发表于 2012-12-19 20:25
原来的答案确实没考虑这个，有不少BUG。

Option Explicit
这什么意思

hwc2ycy

Option Explicit，要求变量声明。
没有声明就会报错的。

fangniuji

hwc2ycy 发表于 2012-12-19 20:40
Option Explicit，要求变量声明。
没有声明就会报错的。

谢谢谢谢你的帮忙谢谢！！！