[已解决]Excel 2003 VBA 问题

lkk0063

grf1973 发表于 2016-12-26 14:26
找不到合适的事件，只好用双击事件。在列表框中双击第一条，会全部选中或不选中。

grf1973 你好,
不好意思,要再次麻烦你
如果我想要实现,当按下"搜寻资料"按钮同时,在"巡检表"中，使用函数Left撷取"I2"栏位前13的字元(DW0R-17000001),可自动寻找"输入表"相同批号后，并秀出K2栏位备注栏位的内容(累计)，没资料不要秀(显示空白),这功能是否可于VBA实现
简单来说 : 巡检表的"K2"栏位等于输入表"AY16~AY18"所有内容

grf1973

试试。

lkk0063

grf1973 发表于 2016-12-27 14:10
试试。

再次感谢grf1973帮忙,但备注栏位抓取资料出现重覆两次问题,麻烦了

grf1973

。。。。。

lkk0063

grf1973 发表于 2016-12-27 14:23
。。。。。

grf1973 你好,还要再次麻烦你帮忙, 测试后有发现三点问题:
1.输入批号，抓取资料不知道为何从第二笔资料开始抓取资料(无法抓取到第一笔资料的内容)-如Pic-1
2.M点我只抓取AU~AV资料，但目前会AU~AX资料都抓取到-如Pic-23.使用"自动筛选"后，按下"巡检表"的"搜寻资料"按钮，只能搜寻"自动筛选"后的该批批号，有方法可以搜寻输入表内的所有资料吗?-如Pic-3
谢谢!

grf1973

第1个问题没发现。第2，第3个问题解决了。

lkk0063

grf1973 发表于 2017-1-3 14:48
第1个问题没发现。第2，第3个问题解决了。

老师,
谢谢帮忙,已经可以使用

lkk0063

grf1973 发表于 2017-1-3 14:48
第1个问题没发现。第2，第3个问题解决了。

grf1973 你好,
如果输入表改为每5笔资料(E6:I6)复制至巡检表(F4:J4),需修改么地方?

grf1973

lkk0063 发表于 2017-1-6 13:12
grf1973 你好,
如果输入表改为每5笔资料(E6:I6)复制至巡检表(F4:J4),需修改么地方?

这个比较麻烦。你得提供新的表式过来。应该是改标红的几处。具体要调试后才行。

lkk0063

grf1973 发表于 2017-1-12 11:11
这个比较麻烦。你得提供新的表式过来。应该是改标红的几处。具体要调试后才行。

grf1973 你好,
我有依照你的提示, 尝试修改程式码(如红字标示的地方), 可是不知道是否有问题, 能否帮我确认一下, 谢谢!
-------------------------------------------------------------------------------------------------------------
Private Sub Sel(xstr)
    Dim i, j, jj, k, x, lotno
    Dim ToRange As Range
    Dim tmpArr(), n(), arr
    With Worksheets(1)  
        arr = .Range("a1:an" & .[a65536].End(3).Row)
    End With
    With ActiveSheet
        Set ToRange = .Range("F4:J10")
        ReDim tmpArr(1 To ToRange.Rows.Count, 1 To 5)
        ReDim n(1 To ToRange.Rows.Count)
        ToRange.ClearContents: .[g2] = ""
        xrr = Split(xstr, ",")
        For i = 6 To UBound(arr)
            lotno = arr(i, 1) '批號
            part1 = Left(lotno, 13)
            For Each x In xrr
                If lotno = x Then
                    .Range("G2") = lotno
                    For j = 5 To 39 Step 5
                        k = j / 5
                        For jj = 0 To 4
                             If j <= 37 Then
                                If arr(i, j) <> "" Then
                                    n(k) = n(k) + 1
                                    If n(k) <= 5 Then tmpArr(k, n(k)) = arr(i, j + jj)
                               End If
                            End If
                        Next jj
                    Next j
                End If
                 part2 = Left(x, 13)
                If part1 = part2 Then If InStr(l2, arr(i, 40)) = 0 Then l2 = l2 & "," & arr(i, 40)
            Next
        Next i
        ToRange = tmpArr   
        .[l2] = Mid(l2, 2)
    End With
End Sub
-------------------------------------------------------------------------------------------------------------