把F列进行重新排列（其它的列不变）

Vicel

gaoch35 发表于 2014-11-25 11:36
如果我想把F列有5个相连的单元格全部都删除掉，然后再进行排，怎么改？如果我想把F列有3个相连和5个相连的 ...

三个或五个连续单元格删掉。如果是单个单元格，把“If s - n = 3 Or s - n = 5 Then”改成“If s - n =1 Then”就可以

1. 
   
2. Sub PX()
   
3.     C = 6         '即F列
   
4.     Columns(C).Insert Shift:=xlToRight
   
5.     C1 = Chr(C + 65)
   
6.     C0 = Chr(C + 64)
   
7.     i = 1
   
8.     Rs = Rows.Count
   
9.     Do
   
10.         If Cells(i, C + 1) <> "" Then
    
11.             n = i
    
12.         Else
    
13.             n = Range(C1 & i).End(xlDown).Row
    
14.         End If
    
15.         If n = Rs Then
    
16.             Range(C0 & n) = 1
    
17.             GoTo 1
    
18.         End If
    
19.         s = Range(C1 & n & ":" & C1 & Rs).Find("", , , , 1).Row
    
20.         arr = Range(C1 & n & ":" & C1 & s)
    
21.         If s - n = 3 Or s - n = 5 Then
    
22.             Range(C1 & n).Resize(UBound(arr), 1) = ""
    
23.             GoTo 2
    
24.         End If
    
25.         Range(C0 & n).Resize(UBound(arr), 1) = s - n
    
26. 2:        i = s + 1
    
27.     Loop Until i > Range(C1 & Rs).End(xlUp).Row
    
28. 1:  Range(C0 & ":" & C1).Sort Key1:=Range(C0 & 1), Order1:=xlAscending, Header:=xlNo, _
    
29.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    
30.         :=xlPinYin, DataOption1:=xlSortNormal
    
31.     Columns(C0).Delete Shift:=xlToLeft
    
32. End Sub
    

复制代码

gaoch35

Vicel 发表于 2014-11-25 11:45
三个或五个连续单元格删掉。如果是单个单元格，把“If s - n = 3 Or s - n = 5 Then”改成“If s - n =1  ...

如果把单个单元格全部都删除掉，再排怎么改

Vicel

gaoch35 发表于 2014-11-25 11:51
如果把单个单元格全部都删除掉，再排怎么改

单个单元格清除

1. Sub PX()
   
2.     C = 6         '即F列
   
3.     Columns(C).Insert Shift:=xlToRight
   
4.     C1 = Chr(C + 65)
   
5.     C0 = Chr(C + 64)
   
6.     i = 1
   
7.     Rs = Rows.Count
   
8.     Do
   
9.         If Cells(i, C + 1) <> "" Then
   
10.             n = i
    
11.         Else
    
12.             n = Range(C1 & i).End(xlDown).Row
    
13.         End If
    
14.         If n = Rs Then
    
15.             Range(C0 & n) = 1
    
16.             GoTo 1
    
17.         End If
    
18.         s = Range(C1 & n & ":" & C1 & Rs).Find("", , , , 1).Row
    
19.         arr = Range(C1 & n & ":" & C1 & s)
    
20.         If s - n = 1 Then
    
21.             Range(C1 & n).Resize(UBound(arr), 1) = ""
    
22.             GoTo 2
    
23.         End If
    
24.         Range(C0 & n).Resize(UBound(arr), 1) = s - n
    
25. 2:        i = s + 1
    
26.     Loop Until i > Range(C1 & Rs).End(xlUp).Row
    
27. 1:  Range(C0 & ":" & C1).Sort Key1:=Range(C0 & 1), Order1:=xlAscending, Header:=xlNo, _
    
28.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    
29.         :=xlPinYin, DataOption1:=xlSortNormal
    
30.     Columns(C0).Delete Shift:=xlToLeft
    
31. End Sub

复制代码

gaoch35

Vicel 发表于 2014-11-25 12:15
单个单元格清除

如果把空格符除外，怎么改，即一个单元格中只有空格符就不算

gaoch35

Vicel 发表于 2014-11-25 12:15
单个单元格清除

如果把空格符除外，怎么改，即一个单元格中只有空格符就不算

Vicel

gaoch35 发表于 2014-11-26 09:35
如果把空格符除外，怎么改，即一个单元格中只有空格符就不算

看代码For Each a In Range(C1 & "1:" & C1 & Range(C1 & Rs).End(xlUp).Row).Cells        
        b = a.Value
        a.Value = IIf(Trim(b) = "", "", b)
Next
判断一个单元格如果只含空格符就清空

1. 
   
2. Sub PX()
   
3.     C = 6         '即F列
   
4.     Columns(C).Insert Shift:=xlToRight
   
5.     C1 = Chr(C + 65)
   
6.     C0 = Chr(C + 64)
   
7.     i = 1
   
8.     Rs = Rows.Count
   
9.     For Each a In Range(C1 & "1:" & C1 & Range(C1 & Rs).End(xlUp).Row).Cells
   
10.         b = a.Value
    
11.         a.Value = IIf(Trim(b) = "", "", b)
    
12.     Next
    
13.     Do
    
14.         If Cells(i, C + 1) <> "" Then
    
15.             n = i
    
16.         Else
    
17.             n = Range(C1 & i).End(xlDown).Row
    
18.         End If
    
19.         If n = Rs Then
    
20.             Range(C0 & n) = 1
    
21.             GoTo 1
    
22.         End If
    
23.         s = Range(C1 & n & ":" & C1 & Rs).Find("", , , , 1).Row
    
24.         arr = Range(C1 & n & ":" & C1 & s)
    
25.         If s - n = 1 Then
    
26.             Range(C1 & n).Resize(UBound(arr), 1) = ""
    
27.             GoTo 2
    
28.         End If
    
29.         Range(C0 & n).Resize(UBound(arr), 1) = s - n
    
30. 2:        i = s + 1
    
31.     Loop Until i > Range(C1 & Rs).End(xlUp).Row
    
32. 1:  Range(C0 & ":" & C1).Sort Key1:=Range(C0 & 1), Order1:=xlAscending, Header:=xlNo, _
    
33.         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    
34.         :=xlPinYin, DataOption1:=xlSortNormal
    
35.     Columns(C0).Delete Shift:=xlToLeft
    
36. End Sub
    

复制代码

gaoch35

Vicel 发表于 2014-11-24 11:52
用到H列来做辅助列

帮帮忙，谢谢，把某一列或几列完全相同的单元格全部都删除掉
http://club.excelhome.net/thread-1169366-1-1.html