|
本帖最后由 fcdd 于 2013-9-2 18:28 编辑
大侠请出手提供代码
对不起我表达的意思有无,,,请原谅。。。。
我的意思是 点击 窗体右上角红色关闭 时 停止代码继续运行(蓝色代码)
Sub 采购_确认_单击()
Application.ScreenUpdating = False
Dim i%, rng As Range '打钩复制
For i = 1 To Cells(Rows.Count, 3).End(3).Row
If Cells(i, 3) = "√" Then
If rng Is Nothing Then Set rng = Cells(i, 4).Resize(, 13) Else Set rng = Union(rng, Cells(i, 4).Resize(, 13))
End If
Next
If Not rng Is Nothing Then rng.Copy Sheets("数据连接").Range("E5")
UserForm1收货.Show
Dim sTemp As String 'D整列自动复制
Dim arr
arr = Range("C4:D" & Range("C110").End(3).Row) 'C4到D列
sTemp = arr(1, 1) 'M开始的第一为相同列
For i = 2 To UBound(arr)
If arr(i, 1) = sTemp Then 'M开始的第一为相同列
arr(i, 2) = arr(i - 1, 2) 'M开始向后数列,自动复制
Else
sTemp = arr(i, 1) 'M开始的第一为相同列
End If
Next
Range("C4").Resize(UBound(arr), 2) = arr 'M开始到U9列
Application.ScreenUpdating = True
End Sub
|
|