从E3:KM3不为空的留下来其他给我删除掉怎么写VBA

jylai · 发表于 2024-4-27 08:00

本帖最后由 jylai 于 2024-4-27 09:08 编辑

然后不为空从右往左移动到前面来

swl4561255 · 发表于 2024-4-27 08:12

参考代码：

Sub test()
Dim myr As Range
ar = Range("A1").CurrentRegion.Columns.Count
For i = 5 To ar
If Cells(3, i) <> "" Then
If myr Is Nothing Then
Set myr = Range(Cells(1, i), Cells(3, i))
Else
Set myr = Union(myr, Range(Cells(1, i), Cells(3, i)))
End If
End If
Next
myr.Copy [E12]
End Sub

复制代码

jylai · 发表于 2024-4-27 08:31

本帖最后由 jylai 于 2024-4-27 08:46 编辑

老师您误会我的意思了
老师打X的不理他（结果样版而已），是想把A1:KM5结果跟A12:E14像那样（像图片这样，框紅色一模一樣）

PS ：原来的 Sheet1 直接变成图片这样

swl4561255 · 发表于 2024-4-27 08:41

jylai 发表于 2024-4-27 08:31
老师您误会我的意思了
老师打X的不理他（结果样版而已），是想把A1:KM5结果跟A12:E14像那样（像图片这样 ...

试试下面的代码：
Sub test()
Application.ScreenUpdating = False
ar = Range("A1").CurrentRegion.Columns.Count
For i = ar To 5 Step -1
If Cells(3, i) = "" Then
Range(Cells(1, i), Cells(3, i)).Delete shift:=xlToLeft
End If
Next
Application.ScreenUpdating = True
End Sub

gwjkkkkk · 发表于 2024-4-27 09:03

Option Explicit
Sub TEST2()
Dim ar, i&

Application.ScreenUpdating = False

With [A1].CurrentRegion
      ar = .Value
      For i = UBound(ar, 2) To 3 Step -1
         If Len(ar(3, i)) = 0 Then .Columns(i).Delete
      Next i
End With

Application.ScreenUpdating = True
Beep
End Sub

gwjkkkkk · 发表于 2024-4-27 09:03

...........

jylai · 发表于 2024-4-27 09:08

gwjkkkkk 发表于 2024-4-27 09:03
...........

完全正确，感谢老师帮忙，没花了，明天送

quqiyuan · 发表于 2024-4-27 10:58

		自动登录	找回密码
密码			免费注册

[已解决] 从E3:KM3不为空的留下来其他给我删除掉怎么写VBA

评分

评分

评分