如何按指定范围提取数据

阿力力

axiu5 发表于 2022-11-25 14:26

OK了，大师，谢谢。

阿力力

axiu5 发表于 2022-11-25 14:26

大师，数据一多卡死电脑了。一行一行的往变，能不能用数组法，一次性写入表内。并且去掉空行。向上缩进。

gwjkkkkk

数组法，请楼主参考 。。。
Sub TEST()
    Dim arr, brr, i&, j&, iMin&, iMax&, t#
    Application.ScreenUpdating = False
    brr = Split([BH1], "~"): t = Timer
    iMin = Val(brr(0)): iMax = Val(brr(1))
    With Range("C2").CurrentRegion
        arr = Intersect(.Offset(), .Offset(1))
    End With
    With Range("BH1").CurrentRegion
        .Offset(2, 2).ClearContents
        brr = Intersect(.Offset(), .Offset(2))
    End With
    For i = 1 To UBound(brr)
       If brr(i, 1) >= iMin And brr(i, 1) <= iMax Then
          For j = 1 To UBound(arr, 2)
              brr(i, j + 2) = arr(i, j)
          Next j
       End If
    Next i
    [BH3].Resize(UBound(brr), UBound(brr, 2)) = brr
    Application.ScreenUpdating = True
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub

gwjkkkkk

数组法，请参考附件。。。

迷途羊羔

在第二个工作表“数据源”中。你看下是这个意思不。

阿力力

迷途羊羔 发表于 2022-11-25 22:12
在第二个工作表“数据源”中。你看下是这个意思不。

大师，正要这样的提取结果，但几万行数据一行一行往下变卡死电脑了。能给改成数组或字典法。就行了。

阿力力

gwjkkkkk 发表于 2022-11-25 19:38
数组法，请参考附件。。。

没删除空行呀。

准提部林

TEST///
Xl0000231.rar (182.97 KB, 下载次数: 17)

2022-11-26 11:56 上传

点击文件名下载附件

阿力力

准提部林 发表于 2022-11-26 11:56
TEST///

这次真的顶事了。速度快了。正是想要的结果。谢谢大师。

迷途羊羔

阿力力 发表于 2022-11-26 11:23
大师，正要这样的提取结果，但几万行数据一行一行往下变卡死电脑了。能给改成数组或字典法。就行了。

数组还在学，看哈其他老师的吧。