自动提取一定数量的列数据并自动更新

msw2395

自动提取一定数量的列数据并自动更新，麻烦老师们给个代码公式，谢谢！！

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, i&, n&, strFileName$, strPath$
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "原始数据.xlsm"
    If Dir(strFileName) = "" Then MsgBox "指定的文件不存在，请检查！", vbExclamation: Exit Sub
   
    Application.ScreenUpdating = False
    ReDim ar(1 To 24)
    With GetObject(strFileName)
        br = .Worksheets(1).[A2].CurrentRegion.Value
        For i = 1 To 10
            If i > UBound(br) Then Exit For
            ar(i) = br(i, 1)
        Next i
        n = UBound(br) + 1
        For i = 15 To 24
            n = n - 1
            If n = 0 Then Exit For
            ar(i) = br(n, 1)
        Next i
        .Close False
    End With
   
    [B5].Resize(, UBound(ar)) = ar
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

。。。。。。。。。。。。。

lsc900707

测试参考附件：

msw2395

lsc900707 发表于 2024-7-21 11:52
测试参考附件：

感谢lsc900707老师，很好。麻烦老师再看下增加1列，代码如何更改呢

msw2395

gwjkkkkk 发表于 2024-7-21 11:16
。。。。。。。。。。。。。

谢谢老师解答！！但用不起，更新不了，不知哪里有错

lsc900707

msw2395 发表于 2024-7-21 16:09
感谢lsc900707老师，很好。麻烦老师再看下增加1列，代码如何更改呢

依样画葫芦即可：

msw2395

lsc900707 发表于 2024-7-21 17:00
依样画葫芦即可：

谢谢xsc900707老师，很方便，但对我这个小白来说，还是挺难的，如果再增加几列，就更不懂了。分开设置简单些，要如何弄呢？比如A列这个宏名叫test1,B列宏名叫test2,test2的代码如何更改呢？试了几次结果都是输出A列的数据，还望老师帮忙解答下

lsc900707

msw2395 发表于 2024-7-21 17:51
谢谢xsc900707老师，很方便，但对我这个小白来说，还是挺难的，如果再增加几列，就更不懂了。分开设置简 ...

分开也行呀：

msw2395

lsc900707 发表于 2024-7-21 20:26
分开也行呀：

谢谢xsc900707老师，完美解决问题