根据关键词 调取

爱疯

Option Explicit

Sub test()
    Dim A, d, i, x
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")

    '1）写
    Sheets(2).Select
    A = Range("a1").CurrentRegion
    For i = 3 To UBound(A)
        x = A(i, 1) & "|" & A(i, 2)
        If A(i, 3) <> "" Then d(x) = A(i, 3)
    Next i

    '2）读
    Sheets(1).Select
    A = Range("a4").CurrentRegion
    For i = 2 To UBound(A)
        x = A(i, 1) & "|" & A(i, 2)
        If d.exists(x) Then A(i, 3) = d(x)
    Next i

    Range("a4").Resize(UBound(A), UBound(A, 2)) = A
End Sub


'从C列的总个数里，随机取10个
Function test2(str)
    Dim x, y, z, arr, brr(), i, t
    arr = VBA.Split(str, ",")
    x = LBound(arr): y = UBound(arr): z = IIf(y > 10, 10, y)
    ReDim brr(1 To z)

    For i = x To x + z - 1
        t = Int((y - i + 1) * Rnd) + i
        brr(i - x + 1) = arr(t)
        arr(t) = arr(i)
    Next i

    test2 = Join(brr, ",")
End Function
提取数据3.rar (16.56 KB, 下载次数: 6)

2020-1-4 09:31 上传

点击文件名下载附件

ptguanyao1

爱疯 发表于 2020-1-3 20:22
手机回，没测试，如果还不行，上传失败附件，只能明天再看

非常感谢 可以了