[已解决]用VBA去掉空格后在指定区域重新排列数据

快乐童年

     谢谢你的关注和热心。先致谢啦。问题要求附件里有说明。希望得到你的帮助。

最佳答案

月排行榜 / 总排行榜

wayy

2013-5-29 10:02

1. Sub test()
   
2.     Dim a, i, j, arr, arra
   
3.     a = Sheets(1).Cells(60000, 1).End(xlUp).Row
   
4.     arra = Sheets(1).Cells(1, 1).Resize(a, 6)
   
5.     ReDim arr(1 To a, 1 To 6)
   
6.     For i = 1 To 6
   
7.         For j = 1 To a
   
8.             If arra(j, i) <> 0 And arra(j, i) <> "" Then
   
9.                 k = k + 1
   
10.                 arr(k, i) = arra(j, i)
    
11.             End If
    
12.         Next j
    
13.         k = 0
    
14.     Next i
    
15.     Sheets(2).Cells(1, 1).Resize(a, 6) = arr
    
16. End Sub

复制代码

试一下这个，不知道是不是原行数上的数据保留在一行上还是只要是空格都上移。

跳转到最佳答案楼层

1032446692

Sub test()
    Dim a, i, j, arr, arra
    a = Sheets(1).Cells(60000, 1).End(xlUp).Row
    arra = Sheets(1).Cells(1, 1).Resize(a, 6)
    ReDim arr(1 To a, 1 To 6)
    For i = 1 To 6
        For j = 1 To a
            If arra(j, i) <> 0 And arra(j, i) <> "" Then
                MsgBox Len(arr(j, i))
                k = k + 1
                arr(k, i) = arra(j, i)
            End If
        Next j
        k = 0
    Next i
    Sheets(2).Cells(1, 1).Resize(a, 6) = arr
End Sub

快乐童年

管理员。谢谢啊，不过，我把代码粘进去后，速度够快啦。但是在sheet2中没有发现那么数据啊，还是空的。能否将你的附件传上来啊。不知道我哪里出问题啦。主要是。

xdd_sky

arra = Sheets(1).Cells(1, 1).Resize(a, 6)
吧这行代码中的arra的后面一个a去掉  估计就可以了。。。

快乐童年

去掉后，运行就出错啦。

1032446692

1. Sub test()
   
2. Dim a, i, j, arr, arra
   
3. a = Sheets(1).Cells(60000, 1).End(xlUp).Row
   
4. arra = Sheets(1).Cells(1, 1).Resize(a, 6)
   
5. ReDim arr(1 To a, 1 To 6)
   
6. For i = 1 To 6
   
7. For j = 1 To a
   
8. If arra(j, i) <> 0 And arra(j, i) <> "" Then
   
9. MsgBox Len(arr(j, i))
   
10. k = k + 1
    
11. arr(k, i) = arra(j, i)
    
12. End If
    
13. Next j
    
14. k = 0
    
15. Next i
    
16. Sheets(2).Cells(1, 1).Resize(a, 6) = arr
    
17. End Sub
    

复制代码

wayy

1. Sub test()
   
2.     Dim a, i, j, arr, arra
   
3.     a = Sheets(1).Cells(60000, 1).End(xlUp).Row
   
4.     arra = Sheets(1).Cells(1, 1).Resize(a, 6)
   
5.     ReDim arr(1 To a, 1 To 6)
   
6.     For i = 1 To 6
   
7.         For j = 1 To a
   
8.             If arra(j, i) <> 0 And arra(j, i) <> "" Then
   
9.                 k = k + 1
   
10.                 arr(k, i) = arra(j, i)
    
11.             End If
    
12.         Next j
    
13.         k = 0
    
14.     Next i
    
15.     Sheets(2).Cells(1, 1).Resize(a, 6) = arr
    
16. End Sub

复制代码

试一下这个，不知道是不是原行数上的数据保留在一行上还是只要是空格都上移。

wayy

1. Sub test()
   
2.     Dim a, i, j, arr, arra
   
3.     a = Sheets(1).Cells(60000, 1).End(xlUp).Row
   
4.     arra = Sheets(1).Cells(1, 1).Resize(a, 6)
   
5.     ReDim arr(1 To a, 1 To 6)
   
6.     For j = 1 To a
   
7.       For i = 1 To 6
   
8.             If arra(j, i) <> 0 And arra(j, i) <> "" Then
   
9.                 k = k + 1
   
10.                 arr(k, i) = arra(j, i)
    
11.             End If
    
12.       Next i
    
13.     Next j
    
14.     Sheets(2).Cells(1, 1).Resize(a, 6) = arr
    
15. End Sub

复制代码

　　两者二选一

快乐童年

谢谢wayy版主 实现要求啦。再次感谢你。希望你身体好，心情好。工作好，家庭好。呵呵

qunaihan

我是新来的。请教版主：您上面那个代码要怎样改动才能满足我的这个请求？我的请求是：希望能用VBA将表1的数据按顺序提取到表2，A列对应B列C列的空格依然保留。