|
发表于 2017-2-19 20:18
|
显示全部楼层
本楼为最佳答案
本帖最后由 lygkkk 于 2017-2-19 20:37 编辑
- Private Sub 点击_Click()
- Application.ScreenUpdating = False
- Dim First_Position
- Dim Last_Position
- Dim Temp As String
- Dim arr
-
- For Each Rng In Sheet1.Range("k14:bm30")
- If Rng.Interior.Color = 65535 Or Rng.Interior.Color = 255 Then
- Temp = Temp & "," & Rng.Address
- End If
- Next
-
- arr = Split(Temp, ",")
- Temp = Selection.Address
-
- Sheet1.Range(arr(1), arr(UBound(arr) / 2)).Copy Sheet1.Range(Temp)
- Sheet1.Range(arr(UBound(arr) / 2 + 1), arr(UBound(arr))).Copy
- Sheet1.Range(Temp).PasteSpecial Paste:=xlPasteValues
- Range(Temp).Select
- Application.ScreenUpdating = True
- End Sub
复制代码
好了 应该没什么大问题了加了个按钮 如果没看见 往右拉
|
|