数据查找 然后写入其它表

不知道为什么

mqj80 发表于 2018-7-12 20:28
目的把“进行中”的记录写到表2   但是又不是把全部“进行中”的记录都写入表2  存在相同“业务号”的就 ...

如果，相同业务号都是进行中的状态，需要写入sheet2？

jiminyanyan

10几楼都没把问题讲清楚呀．．．

不知道为什么

mqj80 发表于 2018-7-12 20:28
目的把“进行中”的记录写到表2   但是又不是把全部“进行中”的记录都写入表2  存在相同“业务号”的就 ...

下面的代码是将进行中的相同业务编号没有完结状态的单据写入sheet2表，自己测试把

不知道为什么

jiminyanyan 发表于 2018-7-12 20:59
10几楼都没把问题讲清楚呀．．．

我大概能猜出来了，虽然不是很肯定。呵呵

mqj80

不知道为什么 发表于 2018-7-12 20:30
如果，相同业务号都是进行中的状态，需要写入sheet2？

刚看到  不好意 有相同业务号 就不写了，只能说明状态输错了。

mqj80

不知道为什么 发表于 2018-7-12 21:01
下面的代码是将进行中的相同业务编号没有完结状态的单据写入sheet2表，自己测试把

Sub test()
    Dim Rng As Range, TopRow&
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
        arr = .[a1].CurrentRegion
        For i = 2 To UBound(arr)
            If Not dic.exists(arr(i, 8)) Then
               Set dic(arr(i, 8)) = CreateObject("scripting.dictionary")
               End If
       dic(arr(i, 8))(arr(i, 1)) = dic(arr(i, 8))(arr(i, 1)) & "｜" & arr(i, 1)
       Next i
       For i = 2 To UBound(arr)
         If arr(i, 1) = "进行中" Then
         mm = Join(dic(arr(i, 8)).Keys, "-")
         If InStr(mm, "完结") = 0 Then
         If Rng Is Nothing Then
         Set Rng = Range("a" & i).Resize(1, UBound(arr, 2))
         Else
         Set Rng = Union(Rng, Range("a" & i).Resize(1, UBound(arr, 2)))
       End If
     End If
    End If
    Next i
    End With
    With Sheet2
    If Not Rng Is Nothing Then
    TopRow = .Cells(.Rows.Count, 2).End(3).Row + 1
    Rng.Copy .Range ("a" & TopRow)  报错 无法复制
    End If
    End With

End Sub

不知道为什么

mqj80 发表于 2018-7-12 22:11
Sub test()
    Dim Rng As Range, TopRow&
    Set dic = CreateObject("scripting.dictionary")

copy 后面有一空格

不知道为什么

mqj80 发表于 2018-7-12 22:11
Sub test()
    Dim Rng As Range, TopRow&
    Set dic = CreateObject("scripting.dictionary")

附件         

数据筛选 写入其它表-R.zip (14.96 KB, 下载次数: 7)

2018-7-12 22:44 上传

点击文件名下载附件

mqj80

不知道为什么 发表于 2018-7-12 22:44
附件

谢谢  太感谢了 ！