【原创】VBA（实验1之前的草稿）如何删除每列的 空行 / 空单元格，并且实现重新排序？---写的很不清晰，保存在这吧。

 

一 问题描述，列非空数据重排--进化：删除非空数据后重排

（1）原始问题

• 我想把下表这样的一些数据，转化为，每列数据都往上对齐
• 数据里暂时没有空行，但实际上如果有空行，我是想删除空行的
• 肯定不能手动搞吧，容易出错，而且也没法应付很多数据的这种转换。

 

原始数据

15	50	52
29	53	55	56
43	56	58	60	59
51	60	62	64	63
59	64	66	69	67
67	69	71	75	73
81	74	76	80	78	82
89	79	82	86	84	88
97	85	88	92	90	94
111	92	95	99	98	100	91
119	99	102	107	106	108	98
127	107	110	116	115	117	106

目标数据（修改的目标）

15	50	52	56	59	82	91
29	53	55	60	63	88	98
43	56	58	64	67	94	106
51	60	62	69	73	100
59	64	66	75	78	108
67	69	71	80	84	117
81	74	76	86	90
89	79	82	92	98
97	85	88	99	106
111	92	95	107	115
119	99	102	116
127	107	110

 

（2） 衍生的通用问题：删除每列不规则数据中的空数据，且往上排

                                      变成一个通用问题，包含上一种情况

 

1		1	1
2	1		2
3	2		3
			4
5		2	5
6	5	3	6
7	6		7
	7	5	8	1
			9	2
3		10	10	7

 

 

二   针对原始问题的EXCEL公式方法

2.1 这个方法比如容易些，但局限性比较强

原理

1. 先算出/数出，每列的空行
2. 所有数据，都往上挪动空行数这么多行
3. 因为针对的是空行都分布在一起，所以这么简单些没问题

步骤：

1.  增加辅助列，辅助列自己手动数出来的，空置了几行，填行数
2. 下面输入公式
3. IF(INDIRECT("r"&(ROW(F3)+F$28)&"c"&COLUMN(F3),FALSE)=0,"",INDIRECT("r"&(ROW(F3)+F$28)&"c"&COLUMN(F3),FALSE))
4. 往下拉公式

 

左上角是a1

index1	index2		r1	r2	r3	r4	r5	r6
0	0	15	50	52
1	1	29	53	55	56
2	2	43	56	58	60	59
3	3	51	60	62	64	63
4	4	59	64	66	69	67
5	5	67	69	71	75	73
6	6	81	74	76	80	78	82
7	7	89	79	82	86	84	88
8	8	97	85	88	92	90	94
9	9	111	92	95	99	98	100	91
10	10	119	99	102	107	106	108	98
11	11	127	107	110	116	115	117	106
			0	0	1	2	6	9
index1	index2		r1	r2	r3	r4	r5	r6
0	0	15	50	52	56	59	82	91
1	1	29	53	55	60	63	88	98
2	2	43	56	58	64	67	94	106
3	3	51	60	62	69	73	100
4	4	59	64	66	75	78	108
5	5	67	69	71	80	84	117
6	6	81	74	76	86	90
7	7	89	79	82	92	98
8	8	97	85	88	99	106
9	9	111	92	95	107	115
10	10	119	99	102	116
11	11	127	107	110

 

2.2 针对通用情况，是否可以写公式解决？

    我需要思考下？

   虽然EXCEL公式相对用的多一些，但是我感觉excel 工作表函数公式 主要用于处理静态数据，筛选等

   有点动态处理的问题，都得靠VBA?

    不知道对不对，之后再反思下这里用 工作表函数写写

 

三  VBA实现批量删除每里的空行

3.1 建立模型前-----问题重新描述

• 要能自动识别，删除，没列种的空白数据
• 然后所有其他非空数据，自动排列
• 暂时定位自动往上排？

 

3.2 VBA第1版：简单，还原excel 工作表函数 思路

思路

• 先识别有多少空行
• 所有单元格整体挪几行

左上角a1

1
2
3
4		1
5		2
6		3
7		4
		5
		6
		7

Sub 置顶()
    count_a = 10 - WorksheetFunction.CountA([a1:a10])
    For i = 1 To 10
        Sheet1.Cells(i + count_a, 3) = Sheet1.Cells(i, 1)
    Next i
End Sub

 

3.3 VBA第2版：还原excel 工作表函数 思路

1
2	1
3	2		1
4	3	1	2
5	4	2	3
6	5	3	4
7	6	4	5
8	7	5	6	1
9	8	6	7	2
10	9	7	8	3
0	1	3	2	7
1	1	1	1	1
2	2	2	2	2
3	3	3	3	3
4	4	4	4
5	5	5	5
6	6	6	6
7	7	7	7
8	8		8
9	9
10

Sub 置顶()
Rem 需要实现的是多列的转换而不只是1列的
    For j = 1 To 5
Rem     count_a = 10 - WorksheetFunction.CountA(Range("A1:A10"))
        count_a = 10 - WorksheetFunction.CountA(Range(Cells(1, j), Cells(10, j)))
Rem     count_a = 10 - WorksheetFunction.CountA([cells(1,j):cells(10,j)])
        Cells(11, j) = count_a
        For i = 1 To 10
            If (i + count_a) <= 10 Then
               Sheet1.Cells(12 + i, j) = Sheet1.Cells(i + count_a, j)
            ElseIf (i + count_a) > 10 Then
               Sheet1.Cells(12 + i, j) = ""
            End If
        Next i
    Next j
End Sub

 

四 面对通用数据问题--VBA如何处理？

 

4.1 比如 面对这样的比较随意空行的数据

 

1		1	1
2	1		2
3	2		3
			4
5		2	5
6	5	3	6
7	6		7
	7	5	8	1
			9	2
3		10	10	7

4.3 几个不同的大思路

1. 走内部循环，最后逐个移动，改变原始数据
2. 走删除空行的思路

 

4.3 整理自己的  建模思路

之前的思路不太通用， 比较通用的思路，应该是这样

• 先逐列，循环
• 再逐行，循环
• 判断是否超过了目标区域的范围
• 判断目标列里的单元格，是否有内容，如果有内容则写入，
• 如果没内容，继续往下读，直到找到有内容的（但不能超出边界），并且保存变量
• 不要重复取数据，因为多个空行可能会直接都会取同一个下面的有数据的单元格

 

4.4  一段代码：只实现了迭代往下取非空数据功能，但未实现删除空数据功能

比较了别人的思路，我感觉我是吧自己绕进去了，思路太不清晰，郁闷呢

 

Sub 置顶()
Rem 需要实现，对目标区域数据分布无要求，更有通用性
Rem 怎么让一个值只被用一遍？
    For j = 1 To 5
        d = 0
        e = 0
        For i = 1 To 10
            b = 0
            a = i
            e = e + d
flag1:
            If IsEmpty(Cells(a, j)) Then
                b = b + 1
                a = a + 1
                GoTo flag1
                
            Else
                Sheet1.Cells(i + 20, j) = Sheet1.Cells(i + b, j)
                
            End If
            If b > 0 Then
               d = 1
            End If
        Next i

自己写了个新的

Sub delrow()

For i = 15 To 1 Step -1
    If Sheets("Sheet4").Cells(i, 1) = "" Then
       Rows(i).Delete
    End If

Next i

End Sub

 

 

五 查到的思路

 

5.1 这个方法的思路和优点！

• 思路清晰，写的非常简练，不是有积累的高手写不出来，羡慕！
• 不重复造轮子，而是直接用现有合适的 方法，函数等解决问题
• 几行代码，执行很快

Sub shangchu1()

Worksheets("sheet1").UsedRange.SpecialCells(xlCellTypeBlanks).Select

Selection.Delete Shift:=xlUp

End Sub

 

 

5.2 思路2简练清晰

• 为啥要用f , 因为  f,i 就不是一个东西，用一个变量i 不对，容易出问题，不同步等
• 取有用数据，非空数据不取就行了，为啥要也循环10次？
• 还有一种简单思路，中转法，把 原始数据取了以后，放到一个数组里，然后再写入到目标去即可，

Sub 置顶()
Rem 需要实现，对目标区域数据分布无要求，更有通用性
Rem 怎么让一个值只被用一遍？
    For j = 1 To 5
        f = 20
        For i = 1 To 10
            If Not IsEmpty(Cells(i, j)) Then
                Sheet1.Cells(f, j) = Sheet1.Cells(i, j)
                f = f + 1
            End If
        Next i
    Next j
End Sub

5.3   删除空行方法

• 倒着删除是精髓，避免了删行导致行号变化的问题
• 很简练

Sub 删除且置顶()
Rem 需要实现，对目标区域数据分布无要求，更有通用性
    For j = 1 To 5
        For i = 10 To 1 Step -1
            If IsEmpty(Cells(i, j)) Then
                Sheet1.Cells(i, j).Delete Shift:=xlUp
            
            End If
        Next i
    Next j
End Sub

 

• 删除法，正面写的方法
• 这个需要处理每次删行后，导致行号变化的问题
• 需要处理1：让循环次序有限，即时跳出
• 知道无限循环的原理，因为下面只要有空行，会一直删（行号变化了，除非10个数都非空）
•  

Sub 删除且置顶()
Rem 需要实现，对目标区域数据分布无要求，更有通用性
    For j = 1 To 5
        a = 0
        For i = 1 To 10 Step 1
        
            If IsEmpty(Cells(i, j)) Then
                Sheet1.Cells(i, j).Delete Shift:=xlUp
                i = i - 1
                a = a + 1
                If a > 10 Then
                    Exit For
                End If
            End If
            
        Next i
        
       
    Next j
End Sub