求助各位大侠帮忙看看代码

咖啡不加牛奶

现有3张表，一张是"信息收集"，一张是"工单查询"，一张是"信息汇总"用来执行汇总提取的表格。
想实现的是功能是：
1：从"工单查询"中，提取A列到M列到"信息汇总"的A列到M列中，（A列只需要“单站验证,单站审核,网优审核,现场联调”四项，B列需要不包含一个关键字皮基站）满足两个条件的信息，提取到"信息汇总"中，表头是一样的。
2：提取后，根据“信息汇总”中的C列“基站名称”再去信息收集表格中，提取V列和W列“驳回分类”“驳回详情”

第一个功能，我看了好多帖子，自己试着修改了一下，但是执行的时候，只能从“工单查询”中提取出一行，并且还是表头，麻烦各位大侠帮忙看看是哪里的问题，并请指正一下，受教学习了，知道哪里的问题，我才好自己再修改。

第二个功能，有时间麻烦也帮忙看一下能否实现，我还在找相应的帖子，不晓得哪个能修改下用。

以下是我写的第一个功能的代码，并上传了附件，麻烦指正一下：

Sub 提取()
Dim t
t = Timer
Dim csv
csv = Dir(Application.ThisWorkbook.Path & "\*.csv")
    'csv工参变量，斜杠\不能少
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
arr = Range("A2:M" & Range("A1048576").End(xlUp).Row)
'需要更新的数据数组arr
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & csv)

arr1 = wb.Worksheets(1).Range("A2:M" & wb.Worksheets(1).Range("A1048576").End(xlUp).Row)
'更新来源的数据数组arr1
wb.Close False

For i = 13 To UBound(arr1)
d(arr1(i, 1)) = i
Next i
For i = 13 To UBound(arr)
If d.exists(arr(i, 1) = "单站验证,单站审核,网优审核,现场联调") Or arr(i, 2) = "皮基站" = 0 Then
    xh = d(arr(i, 1))
    arr(i, 1) = arr1(xh, 2)
    arr(i, 2) = arr1(xh, 3)
End If
Next i
Range("A2").Resize(UBound(arr), 13) = arr
Application.ScreenUpdating = True

MsgBox "工参完成更新，用时" & Timer - t & "秒！"
End Sub

咖啡不加牛奶

冒泡一下~求助

大灰狼1976

应该是这句出的问题，不太理解你的逻辑。

1. If d.exists(arr(i, 1) = "单站验证,单站审核,网优审核,现场联调") Or arr(i, 2) = "皮基站" = 0 Then

复制代码

咖啡不加牛奶

朱荣兴 发表于 2019-6-12 16:29
代码漏洞百出，说明你还连最基本的代码只是都没有，就捣鼓这个复杂的问题，这不是学习VBa之道
Sub 提取()  ...

您指正的对，确实是基础知识比较差，我是真心觉得VBA好用，想学习一下，日常也有在看视频讲解看论坛大神的教学帖子，但是没接触过代码收益较慢，工作又需要常用VBA来提高效率。

有的代码，我稍微能理解它是干什么用的，但是就是不知道怎么改，您发了修改的我就知道以后可以怎么改了。

ReDim arr(1 To UBound(arr1), 1 To 13)
For i = 1 To UBound(arr)
    If Trim(arr1(i, 1)) = "单站验证" Or Trim(arr1(i, 1)) = "单验审核" Or Trim(arr1(i, 1)) = "网优审核" Or Trim(arr1(i, 1)) = "现场联调" Then
    If InStr(arr1(i, 2), "皮基站") = 0 Then
        n = n + 1
        For j = 1 To 13
            arr(n, j) = arr1(i, j)
        Next j
    End If
  End If
Next i


您的代码，输入了就可以用，非常厉害，但是不知道为什么使用今天新导出的“工单查询”表时候，不包含“皮基站”这个条件没有生效，将它一起提取出来了，我尝试修改了一下，能用，但是不确定改的是否正确，是不是正确的修改思路，麻烦您再看一下指正。



第二个功能，我试着写了一个，但是感觉还是有漏洞，像怎么提取制定表格的内容    Set wb = Workbooks.Open(ThisWorkbook.Path & "\移动集中开站工单信息收集") 这句话，我怎么查论坛都没看见相似，我改成了这个样不会报错，但是提取的还是工单的内容。真心不晓得怎么改。



Sub 收集() '''QQ:705664849
Dim d
Dim csv, str, rstr
Dim x, y, r As Integer
Dim arr, rarr
    Set d = CreateObject("Scripting.Dictionary")
    csv = Dir(Application.ThisWorkbook.Path & "\*.csv")
    rarr = Range("C2:R" & Range("C1048576").End(xlUp).Row)
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\移动集中开站工单信息收集")
    arr = wb.Worksheets(1).Range("S2:W" & wb.Worksheets(1).Range("S1048576").End(xlUp).Row)
    wb.Close False
   
    For x = 1 To UBound(arr)
        str = arr(x, 1)                         'csv中的基站名称定义为str
        d(str) = x                              'str写入字典key，Item是在CSV工参对应的行号
    Next x
   
    For y = 1 To UBound(rarr)
        rstr = rarr(y, 1)                       '汇总表中基站名称
            If d.exists(rstr) Then
                r = d(rstr)                     'rstr在字典中的行号，字典的写入是csv的arr数组位置（行号）
                rarr(y, 15) = arr(r, 4)          '更新驳回分类
                rarr(y, 16) = arr(r, 5)          '更新驳回详情
        End If
    Next y
    Range("Q2").Resize(UBound(rarr), 2) = rarr
MsgBox "工参完成更新，用时" & Timer - t & "秒！"
End Sub

麻烦您有时间的时候能够再帮忙指正一下，万分感谢。

咖啡不加牛奶

大灰狼1976 发表于 2019-6-12 16:03
应该是这句出的问题，不太理解你的逻辑。

我这句的意思就是想提取指定的内容，第一列包含那四项，然后第二列不包含皮基站，同时满足这个两个条件的都提取出来。就是新手，语法什么的都写错了，现在晓得怎么写了。

lsc900707

咖啡不加牛奶 发表于 2019-6-13 16:35
您指正的对，确实是基础知识比较差，我是真心觉得VBA好用，想学习一下，日常也有在看视频讲解看论坛大神 ...

Sub gj23w98()
    tms = Timer
    Set d = CreateObject("Scripting.Dictionary")
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "移动集中开站工单信息收集.csv")
    With wb
        arr = .Sheets(1).[a1].CurrentRegion
        .Close False
    End With
    For i = 2 To UBound(arr)
        s = arr(i, 19)
        d(s) = Array(arr(i, 22), arr(i, 23))
    Next
    brr = [a1].CurrentRegion
    For i = 2 To UBound(brr)
        s = brr(i, 3)
        If d.exists(s) Then
            brr(i, 17) = d(s)(0)
            brr(i, 18) = d(s)(1)
        End If
    Next
    [a1].CurrentRegion = brr
    MsgBox "工参完成更新，用时" & Timer - tms & "秒！"
End Sub

lsc900707

咖啡不加牛奶 发表于 2019-6-13 17:49
我这句的意思就是想提取指定的内容，第一列包含那四项，然后第二列不包含皮基站，同时满足这个两个条件的 ...

测试参考附件：

咖啡不加牛奶

lsc900707 发表于 2019-6-13 19:34
Sub gj23w98()
    tms = Timer
    Set d = CreateObject("Scripting.Dictionary")

非常感谢您的回复，大概能看懂了，晓得后面同样的问题应该怎么变动了，学习了。