[已解决]VBA整理数据从一个表到另一个表

诺然偶然

如附件所示，从sheet1原始数据中提取非空和A、B列都有信息的数据到sheet2，先行谢过

最佳答案

月排行榜 / 总排行榜

grf1973

2017-3-29 13:51

1. Sub 整理()
   
2.     arr = Sheet1.Range("a1:b" & Sheet1.[a65536].End(3).Row)
   
3.     For i = 1 To UBound(arr)
   
4.         For j = 1 To UBound(arr, 2)
   
5.             If Len(arr(i, j)) = 0 Then Exit For
   
6.         Next
   
7.         If j > UBound(arr, 2) Then
   
8.             n = n + 1
   
9.             For j = 1 To UBound(arr, 2)
   
10.                 arr(n, j) = arr(i, j)
    
11.             Next
    
12.         End If
    
13.     Next
    
14.     [a1].Resize(n, UBound(arr, 2)) = arr
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 整理()
   
2.     arr = Sheet1.Range("a1:b" & Sheet1.[a65536].End(3).Row)
   
3.     For i = 1 To UBound(arr)
   
4.         For j = 1 To UBound(arr, 2)
   
5.             If Len(arr(i, j)) = 0 Then Exit For
   
6.         Next
   
7.         If j > UBound(arr, 2) Then
   
8.             n = n + 1
   
9.             For j = 1 To UBound(arr, 2)
   
10.                 arr(n, j) = arr(i, j)
    
11.             Next
    
12.         End If
    
13.     Next
    
14.     [a1].Resize(n, UBound(arr, 2)) = arr
    
15. End Sub
    

复制代码

grf1973

还可以先复制，再删除。

1. Sub 整理()
   
2.     With Sheet2
   
3.         Sheet1.Range("a1:b" & Sheet1.[a65536].End(3).Row).Copy .[a1]
   
4.         .Range("a1:b" & Sheet1.[a65536].End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
   
5.     End With
   
6. End Sub

复制代码

wenzili

Public Sub master()
Sheets("原始数据").UsedRange.Copy
Sheets("整理后").Paste Destination:=Sheets("整理后").Range("a1")
Sheets("整理后").UsedRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

wenzili

Public Sub master2()
Dim vaSdata As Variant
Dim vaDdata() As Variant
Dim lMaxrow As Long
Dim i As Long, n As Long
Dim sRng As String
vaSdata = Sheets("原始数据").UsedRange
lMaxrow = UBound(vaSdata)
i = 1
ReDim vaDdata(1 To lMaxrow, 1 To 2)
    For n = 1 To lMaxrow
        If vaSdata(n, 1) <> "" And vaSdata(n, 2) <> "" Then
            vaDdata(i, 1) = vaSdata(n, 1)
            vaDdata(i, 2) = vaSdata(n, 2)
            i = i + 1
        End If
    Next
sRng = "a1" & ":" & "b" & lMaxrow
Sheets("整理后").Range(sRng) = vaDdata
End Sub
数组做法。
grf1973也做了呀，让我学习一下。

诺然偶然

首先非常感谢两位的热心帮助，昨天网上搜了下，自己也倒腾出来一种（附在最后），跟两位的1、2种方法类似，但是我是在原始数据上整理的（貌似要尽量避免在原始数据上动刀），还有就是 grf1973 的第一种方法和 wenzili 的第二种方法貌似都是一样的，这种好像是做个标记什么的，不是很理解：
If j > UBound(arr, 2) Then
            n = n + 1
            For j = 1 To UBound(arr, 2)
                arr(n, j) = arr(i, j)
            Next
        End If
    Next
    [a1].Resize(n, UBound(arr, 2)) = arr
能否把大致思路讲解下，感激不尽

Sheets("原始数据").Select
    maxh = Sheets("全部").Range("a65536").End(3).Row
    Range("c1:c" & maxh).SpecialCells(xlCellTypeBlanks).EntireRow.Delete