求助一个提取的代码

ryoryo66

表格1中从J列开始,每2列的最后一行的2格数字,把他们复制到从A7开始,
如果为空的话,就让那一行空着.

请问这个提取应该怎么写啊?  (A7:B29就是想要的结果)

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    r1 = 7
    Columns("a:b").ClearContents
    For j = 10 To Cells(1, Columns.Count).End(xlToLeft).Column
        r = Cells(Rows.Count, j).End(3).Row
        If VBA.IsNumeric(Cells(r, j)) And Len(Cells(r, j)) > 0 Then
            Cells(r1, 1).Resize(1, 2).Value = Cells(r, j).Resize(1, 2).Value
            r1 = r1 + 1
            j = j + 1
        End If

    Next j
    Application.ScreenUpdating = True
End Sub

蓝桥玄霜

提取数据的代码：

ryoryo66

蓝桥玄霜 发表于 2019-10-6 09:50
提取数据的代码：

非常感谢老师.

这个我在实际使用当中,数据列也是由VBA生成的,可能有的空单元格的问题,导致了代码出错.
麻烦您再帮我看看.

蓝桥玄霜

1. Dim Arr, j&, n&, Myr&, Myc%, r%, Arr1(), i&, ks, js
   
2. [a:h].ClearContents: n = 6
   
3. Arr = ActiveSheet.UsedRange
   
4. Myr = UBound(Arr)
   
5. Myc = [iv1].End(xlToLeft).Column
   
6. Arr = Range("a1").Resize(Myr, Myc)
   
7. For j = 9 To UBound(Arr, 2) 'step 3
   
8.     If Arr(1, j) = "" Then
   
9.        r = r + 1
   
10.        ReDim Preserve Arr1(1 To r)
    
11.        Arr1(r) = j
    
12.     End If
    
13. Next
    
14. For i = 1 To r
    
15.     If i <> r Then
    
16.          js = Arr1(i + 1) - 1
    
17.     Else
    
18.          js = UBound(Arr)
    
19.     End If
    
20.     ks = Arr1(i) + 1
    
21.     Myr = Cells(Rows.Count, ks).End(xlUp).Row
    
22.     n = n + 1
    
23.     If Myr > 1 Then
    
24.         Cells(n, 1) = Arr(Myr, ks): Cells(n, 2) = Arr(Myr, ks + 1)
    
25.     End If
    
26. Next
    

复制代码