根据关键词 调取

ptguanyao1

爱疯 发表于 2020-1-3 11:43
当条件1=对应条件1  条件2=对应条件2    读取瞒足条件的对应行
会不会有多行？比如4楼那样

不会有多行 重复的 ，没行条件都不一样  

ptguanyao1

爱疯 发表于 2020-1-3 11:43
当条件1=对应条件1  条件2=对应条件2    读取瞒足条件的对应行
会不会有多行？比如4楼那样

工作表里面 数据 A b列    同时相同的 不会存在，  在第一个工作表 是A 和B列 数据是会有相同的  

爱疯

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

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

    '2）读
    Sheets(1).Select
    A = Range("a4").CurrentRegion
    For i = 2 To UBound(A)
        If A(i, 1) <> "" And A(i, 2) <> "" Then A(i, 3) = test2(d(A(i, 1) & "|" & A(i, 2)))
    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 = 10
    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



提取数据2.rar (16.63 KB, 下载次数: 5)

2020-1-3 15:20 上传

点击文件名下载附件
这样吗

ptguanyao1

爱疯 发表于 2020-1-3 15:20
Sub test()
    Dim A, d, i
    Application.ScreenUpdating = False

非常感谢

ptguanyao1

爱疯 发表于 2020-1-3 15:20
Sub test()
    Dim A, d, i
    Application.ScreenUpdating = False

第一种情况：在研究你的 代码是 我把数据读取数据修改为1时，  数据库时间量少时  会有读取到数据为空的情况。这种要如何修改。




第二种情况：随机读取数据10个不变，当数据库那边数据低于10个时会提示 下标越界 需要修改哪里
帮忙再指导下，谢谢

爱疯

z=10

改成

z = IIf(y > 10, 10, y)

ptguanyao1

爱疯 发表于 2020-1-3 17:23
z=10

改成

好的  谢谢，第一种问题 我发现是我入数据库 后面多了一个， 造成的 非常感谢

ptguanyao1

爱疯 发表于 2020-1-3 17:23
z=10

改成

改完下面这个有提示了

爱疯

If A(i, 1) <> "" And A(i, 2) <> "" Then

两处都改成

If A(i, 1) <> "" And A(i, 2) <> "" and a(i,3)<>"" Then

爱疯

手机回，没测试，如果还不行，上传失败附件，只能明天再看