请教老师：如何删除指定列和数？

lygyjt

请教各位老师：如何将指定列及指定的数据删除？同时保持数据的连接性。具体请见例子： 如何删除指定列和数？.rar (8.11 KB, 下载次数: 10)

2017-6-25 09:47 上传

点击文件名下载附件

池盛龙

1. Sub CSL()
   
2. For y = 1 To 35
   
3. If Cells(1, y) <> Sheet2.Cells(1, 1) And Cells(1, y) <> Sheet2.Cells(1, 2) And Cells(1, y) <> Sheet2.Cells(1, 3) And Cells(1, y) <> Sheet2.Cells(1, 4) And Cells(1, y) <> Sheet2.Cells(1, 5) And Cells(1, y) <> Sheet2.Cells(1, 6) And Cells(1, y) <> Sheet2.Cells(1, 7) And Cells(1, y) <> Sheet2.Cells(1, 8) Then
   
4. If Cells(1, y) = "" Then
   
5. y = 35
   
6. Else
   
7. 
   
8. Columns(y).Delete
   
9. y = y - 1
   
10. End If
    
11. 
    
12. End If
    
13. 
    
14. Next
    
15. hs = Sheet1.UsedRange.Rows.Count
    
16. For y1 = 1 To 8
    
17. For x = 2 To hs
    
18. If Cells(x, y1) <> Sheet2.Cells(1, 1) And Cells(x, y1) <> Sheet2.Cells(1, 2) And Cells(x, y1) <> Sheet2.Cells(1, 3) And Cells(x, y1) <> Sheet2.Cells(1, 4) And Cells(x, y1) <> Sheet2.Cells(1, 5) And Cells(x, y1) <> Sheet2.Cells(1, 6) And Cells(x, y1) <> Sheet2.Cells(1, 7) And Cells(x, y1) <> Sheet2.Cells(1, 8) Then
    
19. 
    
20. If Cells(x, y1) = "" Then
    
21. x = hs
    
22. Else
    
23. Range(Cells(x, y1), Cells(x, y1)).Select
    
24. Selection.Delete Shift:=xlUp
    
25. x = x - 1
    
26. End If
    
27. 
    
28. End If
    
29. Next
    
30. Next
    
31. 
    
32. End Sub
    
33. 
    
34. 
    

复制代码

池盛龙

不知道我理解的对不

大灰狼1976

1. Sub aaa()
   
2. Dim arr, i&, d As Object, rng As Range, c
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets(2).[a1].CurrentRegion
   
5. For i = 1 To UBound(arr, 2)
   
6.   d(arr(1, i)) = ""
   
7. Next i
   
8. arr = Sheets(1).[a1].CurrentRegion
   
9. For i = 1 To UBound(arr, 2)
   
10.   If Not d.exists(arr(1, i)) Then If rng Is Nothing Then Set rng = Columns(i) Else Set rng = Union(rng, Columns(i))
    
11. Next i
    
12. rng.Delete
    
13. Set rng = Nothing
    
14. For Each c In Sheets(1).[a1].CurrentRegion.Offset(1)
    
15.   If Not d.exists(c.Value) Then If rng Is Nothing Then Set rng = c Else Set rng = Union(rng, c)
    
16. Next c
    
17. rng.Delete Shift:=xlUp
    
18. End Sub

复制代码

lygyjt

大灰狼1976 发表于 2017-6-26 11:50

谢谢池盛龙和大灰狼1976老师的指点！真不好意思，近几天忙一点，连上网的功夫都没了，怠慢你们两位啦！