[已解决]复制问题

fangniuji

数据源A列在M30上加一个M09，然后再加%到M30之间数据，最后再加M48到%之间数据，结果如B列，接着把%以上T后面C数据对应添加%以下T数据中，如C列。最后在原M30和%之间数据T后面加Z-0.02，M09 下复制%到M30之间数据中T后面加Z-0.3，原M48到%之间复制数据T后面加Z-0.0253，最后结果如D列，谢谢

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-9-12 21:51

改进下，把标记检测只在代码入口中做检测，避免后面重复的检测。

1. Sub Main2()
   
2.     Dim lFind As Long, lFind2 As Long
   
3.     Dim lFindPercent As Long, lFindM30 As Long
   
4. 
   
5.     If FindPattern(1, "M48") = 0 Or FindPattern(1, "M30") = 0 Or FindPattern(1, "%") = 0 Then
   
6.         MsgBox "A列数据缺少 M48 或 M30 或 % 标记"
   
7.         Exit Sub
   
8.     End If
   
9. 
   
10.     Application.ScreenUpdating = False
    
11. 
    
12.     lFind = FindPattern(1, "M30")
    
13.     Cells(lFind, 1).Insert shift:=xlDown
    
14.     Cells(lFind, 1).Value = "M09"
    
15.     lFindPercent = FindPattern(1, "%")
    
16.     lFind = FindPattern(1, "M09")
    
17.     lFind2 = FindPattern(1, "M30")
    
18.     Range("a" & lFindPercent + 1 & ":a" & lFind - 1).Copy
    
19.     Range("a" & lFind2).Insert shift:=xlDown
    
20. 
    
21.     Application.CutCopyMode = False
    
22. 
    
23.     lFind = FindPattern(1, "M48")
    
24.     lFindPercent = FindPattern(1, "%")
    
25.     lFind2 = FindPattern(1, "M30")
    
26.     Range("a" & lFind + 1 & ":a" & lFindPercent - 1).Copy
    
27.     Range("a" & lFind2).Insert shift:=xlDown
    
28. 
    
29.     Application.CutCopyMode = False
    
30. 
    
31.     lFindPercent = FindPattern(1, "%")
    
32. 
    
33.     Dim i As Long, l As Long
    
34.     Dim arr
    
35.     Dim strTemp As String
    
36.     arr = Range("a1:b" & lFindPercent - 1).Value
    
37.     For i = LBound(arr) To UBound(arr)
    
38.         strTemp = arr(i, 1)
    
39.         If strTemp Like "T*C.*" Then
    
40.             l = Val(Mid(strTemp, 2, InStr(strTemp, "C") - 1))
    
41.             lFind = FindPattern(1, "T" & l)
    
42.             Do While lFind
    
43.                 If lFind Then
    
44.                     Cells(lFind, 1).Value = Cells(lFind, 1).Value & Mid(strTemp, InStr(strTemp, "C"))
    
45.                 End If
    
46.                 lFind = FindPattern(1, "T" & l)
    
47.             Loop
    
48.         End If
    
49.     Next
    
50. 
    
51.     lFindPercent = FindPattern(1, "%")
    
52.     lFind = FindPattern(1, "M09")
    
53.     For i = lFindPercent + 1 To lFind - 1
    
54.         strTemp = Cells(i, 1).Value
    
55.         If strTemp Like "T*C.*" Then
    
56.             Cells(i, 1).Value = strTemp & "Z-0.02"
    
57.         End If
    
58.     Next
    
59. 
    
60.     lFind2 = FindPattern(1, Cells(lFind - 1, 1).Value, 2)
    
61.     For i = lFind + 1 To lFind2 - 1
    
62.         strTemp = Cells(i, 1).Value
    
63.         If strTemp Like "T*C.*" Then
    
64.             Cells(i, 1).Value = strTemp & "Z-0.3"
    
65.         End If
    
66.     Next
    
67. 
    
68.     lFind = FindPattern(1, "M30")
    
69.     For i = lFind2 + 1 To lFind - 1
    
70.         strTemp = Cells(i, 1).Value
    
71.         If strTemp Like "T*C.*" Then
    
72.             Cells(i, 1).Value = strTemp & "Z-0.0253"
    
73.         End If
    
74.     Next
    
75. 
    
76.     Columns(1).AutoFit
    
77.     Application.ScreenUpdating = True
    
78.     MsgBox "处理完成"
    
79. End Sub
    
80. 
    
81. Function FindPattern(lCol As Long, strPattern As String, Optional Direction As Byte = 1)
    
82.     On Error Resume Next
    
83.     Dim rg As Range
    
84.     Set rg = Columns(lCol).Find(what:=strPattern, LookAt:=xlWhole, SearchDirection:=Direction)
    
85.     If rg Is Nothing Then
    
86.         FindPattern = 0
    
87.     Else
    
88.         FindPattern = rg.Row
    
89.     End If
    
90. End Function
    

复制代码

跳转到最佳答案楼层

sgxb123431380

能在帖子里发一个数据吗？你给的附件打不开

hwc2ycy

1. Sub main()
   
2.     Dim lFind As Long, lFind2 As Long
   
3.     Dim lFindPercent As Long, lFindM30 As Long
   
4.     Application.ScreenUpdating = False
   
5.    
   
6.     lFind = FindPattern(1, "M30")
   
7.     If lFind Then
   
8.         Cells(lFind, 1).Insert shift:=xlDown
   
9.         Cells(lFind, 1).Value = "M09"
   
10.     Else
    
11.         MsgBox "没有找到 M30 标记"
    
12.     End If
    
13.    
    
14.     lFindPercent = FindPattern(1, "%")
    
15.     lFind = FindPattern(1, "M09")
    
16.     lFind2 = FindPattern(1, "M30")
    
17.     If lFindPercent > 0 And lFind2 > 0 Then
    
18.         Range("a" & lFindPercent + 1 & ":a" & lFind - 1).Copy
    
19.         Range("a" & lFind2).Insert shift:=xlDown
    
20.     Else
    
21.         MsgBox "没有找到 % 或 M30 标记"
    
22.     End If
    
23.    
    
24.     Application.CutCopyMode = False
    
25. 
    
26.     lFind = FindPattern(1, "M48")
    
27.     lFindPercent = FindPattern(1, "%")
    
28.     lFind2 = FindPattern(1, "M30")
    
29.     If lFindPercent > 0 And lFind2 > 0 Then
    
30.         Range("a" & lFind + 1 & ":a" & lFindPercent - 1).Copy
    
31.         Range("a" & lFind2).Insert shift:=xlDown
    
32.     Else
    
33.         MsgBox "没有找到 % 或 M30 标记"
    
34.     End If
    
35.    
    
36.     Application.CutCopyMode = False
    
37.     lFindPercent = FindPattern(1, "%")
    
38.     Dim i As Long, l As Long
    
39.     Dim arr
    
40.     Dim strTemp As String
    
41.     arr = Range("a1:b" & lFindPercent - 1).Value
    
42.     For i = LBound(arr) To UBound(arr)
    
43.         strTemp = arr(i, 1)
    
44.         If strTemp Like "T*C.*" Then
    
45.             l = Val(Mid(strTemp, 2, InStr(strTemp, "C") - 1))
    
46.             lFind = FindPattern(1, "T" & l)
    
47.             Do While lFind
    
48.                 If lFind Then
    
49.                     Cells(lFind, 1).Value = Cells(lFind, 1).Value & Mid(strTemp, InStr(strTemp, "C"))
    
50.                 End If
    
51.                 lFind = FindPattern(1, "T" & l)
    
52.             Loop
    
53.         End If
    
54.     Next
    
55.    
    
56.     lFindPercent = FindPattern(1, "%")
    
57.     lFind = FindPattern(1, "M09")
    
58.     If lFindPercent > 0 And lFind > 0 Then
    
59.         For i = lFindPercent + 1 To lFind - 1
    
60.             strTemp = Cells(i, 1).Value
    
61.             If strTemp Like "T*C.*" Then
    
62.                 Cells(i, 1).Value = strTemp & "Z-0.02"
    
63.             End If
    
64.         Next
    
65.     Else
    
66.         MsgBox "没有找到 M09 或 % 标记"
    
67.     End If
    
68.    
    
69.     lFind2 = FindPattern(1, Cells(lFind - 1, 1).Value, 2)
    
70.     If lFind2 Then
    
71.         For i = lFind + 1 To lFind2 - 1
    
72.             strTemp = Cells(i, 1).Value
    
73.             If strTemp Like "T*C.*" Then
    
74.                 Cells(i, 1).Value = strTemp & "Z-0.3"
    
75.             End If
    
76.         Next
    
77.     Else
    
78.         MsgBox "没有找到标记"
    
79.     End If
    
80.    
    
81.     lFind = FindPattern(1, "M30")
    
82.     If lFind Then
    
83.         For i = lFind2 + 1 To lFind - 1
    
84.             strTemp = Cells(i, 1).Value
    
85.             If strTemp Like "T*C.*" Then
    
86.                 Cells(i, 1).Value = strTemp & "Z-0.0253"
    
87.             End If
    
88.         Next
    
89.     Else
    
90.         MsgBox "没有找到 M30 标记"
    
91.     End If
    
92.     Columns(1).AutoFit
    
93.     Application.ScreenUpdating = True
    
94.     MsgBox "处理完成"
    
95. End Sub
    
96. 
    
97. Function FindPattern(lCol As Long, strPattern As String, Optional Direction As Byte = 1)
    
98.     On Error Resume Next
    
99.     Dim rg As Range
    
100.     Set rg = Columns(lCol).Find(what:=strPattern, LookAt:=xlWhole, SearchDirection:=Direction)
     
101.     If rg Is Nothing Then
     
102.         FindPattern = 0
     
103.     Else
     
104.         FindPattern = rg.Row
     
105.     End If
     
106. End Function
     

复制代码

hwc2ycy

用A列数据测试后，无问题。
实际使用前，建议先备份A列数据。
切记，不要重复测试，否则产生的错误无法估量。

hwc2ycy

改进下，把标记检测只在代码入口中做检测，避免后面重复的检测。

1. Sub Main2()
   
2.     Dim lFind As Long, lFind2 As Long
   
3.     Dim lFindPercent As Long, lFindM30 As Long
   
4. 
   
5.     If FindPattern(1, "M48") = 0 Or FindPattern(1, "M30") = 0 Or FindPattern(1, "%") = 0 Then
   
6.         MsgBox "A列数据缺少 M48 或 M30 或 % 标记"
   
7.         Exit Sub
   
8.     End If
   
9. 
   
10.     Application.ScreenUpdating = False
    
11. 
    
12.     lFind = FindPattern(1, "M30")
    
13.     Cells(lFind, 1).Insert shift:=xlDown
    
14.     Cells(lFind, 1).Value = "M09"
    
15.     lFindPercent = FindPattern(1, "%")
    
16.     lFind = FindPattern(1, "M09")
    
17.     lFind2 = FindPattern(1, "M30")
    
18.     Range("a" & lFindPercent + 1 & ":a" & lFind - 1).Copy
    
19.     Range("a" & lFind2).Insert shift:=xlDown
    
20. 
    
21.     Application.CutCopyMode = False
    
22. 
    
23.     lFind = FindPattern(1, "M48")
    
24.     lFindPercent = FindPattern(1, "%")
    
25.     lFind2 = FindPattern(1, "M30")
    
26.     Range("a" & lFind + 1 & ":a" & lFindPercent - 1).Copy
    
27.     Range("a" & lFind2).Insert shift:=xlDown
    
28. 
    
29.     Application.CutCopyMode = False
    
30. 
    
31.     lFindPercent = FindPattern(1, "%")
    
32. 
    
33.     Dim i As Long, l As Long
    
34.     Dim arr
    
35.     Dim strTemp As String
    
36.     arr = Range("a1:b" & lFindPercent - 1).Value
    
37.     For i = LBound(arr) To UBound(arr)
    
38.         strTemp = arr(i, 1)
    
39.         If strTemp Like "T*C.*" Then
    
40.             l = Val(Mid(strTemp, 2, InStr(strTemp, "C") - 1))
    
41.             lFind = FindPattern(1, "T" & l)
    
42.             Do While lFind
    
43.                 If lFind Then
    
44.                     Cells(lFind, 1).Value = Cells(lFind, 1).Value & Mid(strTemp, InStr(strTemp, "C"))
    
45.                 End If
    
46.                 lFind = FindPattern(1, "T" & l)
    
47.             Loop
    
48.         End If
    
49.     Next
    
50. 
    
51.     lFindPercent = FindPattern(1, "%")
    
52.     lFind = FindPattern(1, "M09")
    
53.     For i = lFindPercent + 1 To lFind - 1
    
54.         strTemp = Cells(i, 1).Value
    
55.         If strTemp Like "T*C.*" Then
    
56.             Cells(i, 1).Value = strTemp & "Z-0.02"
    
57.         End If
    
58.     Next
    
59. 
    
60.     lFind2 = FindPattern(1, Cells(lFind - 1, 1).Value, 2)
    
61.     For i = lFind + 1 To lFind2 - 1
    
62.         strTemp = Cells(i, 1).Value
    
63.         If strTemp Like "T*C.*" Then
    
64.             Cells(i, 1).Value = strTemp & "Z-0.3"
    
65.         End If
    
66.     Next
    
67. 
    
68.     lFind = FindPattern(1, "M30")
    
69.     For i = lFind2 + 1 To lFind - 1
    
70.         strTemp = Cells(i, 1).Value
    
71.         If strTemp Like "T*C.*" Then
    
72.             Cells(i, 1).Value = strTemp & "Z-0.0253"
    
73.         End If
    
74.     Next
    
75. 
    
76.     Columns(1).AutoFit
    
77.     Application.ScreenUpdating = True
    
78.     MsgBox "处理完成"
    
79. End Sub
    
80. 
    
81. Function FindPattern(lCol As Long, strPattern As String, Optional Direction As Byte = 1)
    
82.     On Error Resume Next
    
83.     Dim rg As Range
    
84.     Set rg = Columns(lCol).Find(what:=strPattern, LookAt:=xlWhole, SearchDirection:=Direction)
    
85.     If rg Is Nothing Then
    
86.         FindPattern = 0
    
87.     Else
    
88.         FindPattern = rg.Row
    
89.     End If
    
90. End Function
    

复制代码

yezhikang

好长一串代码，看不懂什么意思。