[已解决]增加最后代码，谢谢帮忙

fangniuji

大家帮忙一下代码，把L列坐标加在K列一样刀序坐标最后面，结果如M列，谢谢！！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-3-27 11:10

1. Sub 复制()
   
2.     Dim i As Long
   
3.     Dim lStart As Long
   
4.     Dim lEnd As Long
   
5.     Dim lRow As Long
   
6.     Dim rg As Range
   
7. 
   
8.     Columns("k").Copy Columns("p")
   
9.     i = 1
   
10.     lRow = Cells(Rows.Count, "l").End(xlUp).Row
    
11.     Do While Not (Cells(i, "l") Like "T#" Or Cells(i, "l") Like "T##") And i <= lRow
    
12.         i = i + 1
    
13.         lStart = i
    
14.     Loop
    
15.     If i > lRow Then Exit Sub
    
16.     i = i + 1
    
17.     Do While Not (Cells(i, "l") Like "T#" Or Cells(i, "l") Like "T##" Or Cells(i, "l") Like "M30") And i <= lRow
    
18.         i = i + 1
    
19.         lEnd = i
    
20.     Loop
    
21.     If i > lRow Then Exit Sub
    
22.     Set rg = Range("p:p").Find(what:=Cells(lStart, "l"), lookat:=xlWhole)
    
23.     If rg Is Nothing Then Exit Sub
    
24.     i = rg.Row + 1
    
25.     lRow = Cells(Rows.Count, "p").End(xlUp).Row
    
26.     Do While Not (Cells(i, "p") Like "T#" Or Cells(i, "p") Like "T##" Or Cells(i, "l") Like "M30") And i <= lRow
    
27.         i = i + 1
    
28.     Loop
    
29.     If i > lRow Then Exit Sub
    
30.     Range(Cells(lStart + 1, "l"), Cells(lEnd - 1, "l")).Copy
    
31.     Cells(i, "p").Insert shift:=xlDown
    
32.     Application.CutCopyMode = False
    
33. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub 复制()
   
2.     Dim i As Long
   
3.     Dim lStart As Long
   
4.     Dim lEnd As Long
   
5.     Dim lRow As Long
   
6.     Dim rg As Range
   
7. 
   
8.     Columns("k").Copy Columns("p")
   
9.     i = 1
   
10.     lRow = Cells(Rows.Count, "l").End(xlUp).Row
    
11.     Do While Not (Cells(i, "l") Like "T#" Or Cells(i, "l") Like "T##") And i <= lRow
    
12.         i = i + 1
    
13.         lStart = i
    
14.     Loop
    
15.     If i > lRow Then Exit Sub
    
16.     i = i + 1
    
17.     Do While Not (Cells(i, "l") Like "T#" Or Cells(i, "l") Like "T##" Or Cells(i, "l") Like "M30") And i <= lRow
    
18.         i = i + 1
    
19.         lEnd = i
    
20.     Loop
    
21.     If i > lRow Then Exit Sub
    
22.     Set rg = Range("p:p").Find(what:=Cells(lStart, "l"), lookat:=xlWhole)
    
23.     If rg Is Nothing Then Exit Sub
    
24.     i = rg.Row + 1
    
25.     lRow = Cells(Rows.Count, "p").End(xlUp).Row
    
26.     Do While Not (Cells(i, "p") Like "T#" Or Cells(i, "p") Like "T##" Or Cells(i, "l") Like "M30") And i <= lRow
    
27.         i = i + 1
    
28.     Loop
    
29.     If i > lRow Then Exit Sub
    
30.     Range(Cells(lStart + 1, "l"), Cells(lEnd - 1, "l")).Copy
    
31.     Cells(i, "p").Insert shift:=xlDown
    
32.     Application.CutCopyMode = False
    
33. End Sub

复制代码

hwc2ycy

一对一的，没有通用性，下面要是有很多就不管用了。

hwc2ycy

你只要知道思路就会了。

hwc2ycy

把找寻序号和定位，如果做成单独的函数出来，再加个可选参数，从哪个位置开始找起，可能会更好。

hwc2ycy

呆会重新写个函数，有通用的做法。

hwc2ycy

1. Sub 模式复制()
   
2.     Dim i As Long
   
3.     Dim lStart As Long
   
4.     Dim lEnd As Long
   
5.     Dim lRow As Long
   
6.     Dim rg As Range
   
7.     Dim lDstRow As Long
   
8.     Dim lSrcCol As String
   
9. 
   
10.     lSrcCol = "l"
    
11.     Columns("k").Copy Columns("p")
    
12.     lStart = GetPosition(lSrcCol, "T#", 1)
    
13.     lRow = Cells(Rows.Count, lSrcCol).End(xlUp).Row
    
14. 
    
15.     Do While lStart < lRow
    
16.         If lStart = 0 Then Exit Sub
    
17. 
    
18.         lEnd = GetPosition(lSrcCol, "T#", lStart + 1)
    
19.         If lEnd = 0 Then Exit Sub
    
20. 
    
21.         Set rg = Range("p:p").Find(what:=Cells(lStart, lSrcCol), lookat:=xlWhole)
    
22.         If rg Is Nothing Then Exit Sub
    
23. 
    
24.         lDstRow = GetPosition("p", "T#", rg.Row + 1)
    
25.         If lDstRow = 0 Then Exit Sub
    
26. 
    
27.         Application.ScreenUpdating = False
    
28.         Range(Cells(lStart + 1, lSrcCol), Cells(lEnd - 1, lSrcCol)).Copy
    
29.         Cells(lDstRow, "p").Insert shift:=xlDown
    
30.         Application.CutCopyMode = False
    
31.         Application.ScreenUpdating = True
    
32.         lStart = GetPosition(lSrcCol, "T#", lEnd)
    
33.     Loop
    
34. End Sub
    
35. 
    
36. Function GetPosition(lCol, Pattern As String, Optional lRow As Long = 1) As Long
    
37. '参数lCol，查找的指定列
    
38. '参数Pattern,匹配表达式，可用通配符，通配符格式与LIKE相同
    
39. '参数lRow，指定行，默认为1
    
40. '---------------------------------------------------------------------------------------
    
41. ' Procedure : GetPosition
    
42. ' Author    : hwc2ycy
    
43. ' Date      : 2013/3/27
    
44. ' Purpose   : 在某列从指定行开始查找匹配的行的位置，
    
45. '---------------------------------------------------------------------------------------
    
46. '
    
47.     Dim lLastRow As Long
    
48. 
    
49.     lLastRow = Cells(Rows.Count, lCol).End(xlUp).Row
    
50.     Dim i As Long
    
51.     i = lRow
    
52.     Do While Not (Cells(i, lCol) Like Pattern Or Cells(i, lCol) Like Pattern & "#" Or Cells(i, lCol) Like "M30") And i <= lLastRow
    
53.         i = i + 1
    
54.     Loop
    
55.     If i <= lLastRow Then GetPosition = i
    
56. End Function
    

复制代码

hwc2ycy

L列有多个序列号要复制的都可以解决。

fangniuji

hwc2ycy 发表于 2013-3-27 12:22
L列有多个序列号要复制的都可以解决。

谢谢，谢谢！！！！！！！！！！！！！！！