导入一个文件，在表1，表2中查找是否含有这个数据，有就输入指定数据

义重情深

使用chatgpt试过，但是总是失败，求教大神帮忙，平台为WIN7+excel06，注意兼容性
写一段VBA代码，命名为“整列出车”，在“YT-8出车及过表”这个工作表的C2'D2'E2单元格输入数据后，点击宏按钮，开始执行程序，选择导入的EXCEL文件，在“部属车-YT-8”和“企业车-YT-8”工作表中查找是否有与导入文件中工作表“第1页”的D16单元格一致的车号，如果有，则将“YT-8出车及过表”这个工作表（以下简称表3）的C2、D2、E2单元格（分别为发出车次、发出日期、发出时间）中的数据分别填到“部属车-YT-8”（以下简称表1）或“企业车-YT-8”工作表（以下简称表2）中与D16单元格一致的那一行D、E、F列。如果没有，则记住该车辆未查询到（这里不用提示）。D16查找完毕后，继续向下查找直到该导入文件的工作表“第1页”的最后一行结束，最终弹出对话框：本次应出车XX辆，实际成功出车XX辆（部属车X辆，企业车X辆），未查找到车号X辆。如有未查找到的车号，请确认运统8登记车号与出车编组是否一致。要保证代码运行效率，还要记得 把所有变量声明了 如果可以的话加微信：aasdwe 沟通

义重情深

终于审核通过了

补充内容 (2023-4-30 00:57):
Set ws1 = Worksheets("YT-8出车及过表")Sub 整列出车()
    '声明变量
    Dim wb As Workbook
    Dim ws1 As Worksheet    'YT-8出车及过表
    Dim ws2 As Worksheet    '部属车-YT-8
    Dim ws3 As Workshe...过界

补充内容 (2023-4-30 00:58):
Sub 整列出车()
    '声明变量
    Dim wb As Workbook
    Dim ws1 As Worksheet    'YT-8出车及过表
    Dim ws2 As Worksheet    '部属车-YT-8
    Dim ws3 As Worksheet    '企业车-YT-8
    Dim lastRow As Long     '导入文件中工作表"第1页"的最后一行
    Dim ws As Worksheet
    Dim i As Long           '循环计数器
    Dim outCount As Long    '应出车辆数
    Dim carCount As Long    '出车辆数
    Dim deptCarCount As Long    '部属车成功出车辆数
    Dim entCarCount  As Long   '企业车成功出车辆数
    Dim notFoundCount As Long   '未查找到车号的数量
    Dim carNum As String '导入文件中工作表"第1页"中的车号
    Dim path As String
    Dim rowFound As Boolean    '是否找到了匹配的行
    Dim rngFound As Range
    '初始化变量
    outCount = 0
    carCount = 0
    deptCarCount = 0
    entCarCount = 0
    notFoundCount = 0
    rowFound = False
    '调用文件选取器选择工作簿
    path = Application.GetOpenFilename("Excel文件(*.xls;*.xlsx),*.xls;*.xlsx")
    If path = "" Then
        MsgBox "请选择要导入数据文件!"
        Exit Sub
    End If
    Set wb = Workbooks.Open(path)
    If wb Is Nothing Then GoTo endMacro
    Set ws1 = Worksheets("YT-8出车及过表")
    Set ws2 = Worksheets("部属车-YT-8")
    Set ws3 = Worksheets("企业车-YT-8")
    '获取导入文件中工作表"第1页"的最后一行
    Set ws = wb.Worksheets("第1页")
    With ws
        lastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
    End With
    '循环查找导入文件中工作表"第1页"中的每一行
    For i = 16 To lastRow
        carNum = wb.Worksheets("第1页").Cells(i, 4).Value   '获取车号
        '在部属车表中查找该车号,若找到则将信息填入
        Set rngFound = ws2.Range("D:D").Find(carNum)
        If Not rngFound Is Nothing Then
            deptCarCount = deptCarCount + 1
            ws2.Cells(rngFound.Row, 4) = ws1.Cells(2, 3).Value   '发出车次
            ws2.Cells(rngFound.Row, 5) = ws1.Cells(2, 4).Value   '发出日期
            ws2.Cells(rngFound.Row, 6) = ws1.Cells(2, 5).Value   '发出时间
            rowFound = True
        End If
        '在企业车表中查找该车号,若找到则将信息填入
        Set rngFound = ws3.Range("D:D").Find(carNum)
        If Not rngFound Is Nothing Then
            entCarCount = entCarCount + 1
            ws3.Cells(rngFound.Row, 4) = ws1.Cells(2, 3).Value
            ws3.Cells(rngFound.Row, 5) = ws1.Cells(2, 4).Value
            ws3.Cells(rngFound.Row, 6) = ws1.Cells(2, 5).Value
            rowFound = True
        End If
        '如果未找到,则未查找到车号数量+1
        If rowFound = False Then notFoundCount = notFoundCount + 1
    Next
    '显示执行结果
    Dim msg As String
    msg = "本次出车共导入" & outCount & "辆,实际成功出车" & (deptCarCount + entCarCount) & "辆(部属车" & deptCarCount & "辆,企业车" & entCarCount & "辆),未查找到车号" & notFoundCount
    MsgBox msg
endMacro:
End Sub

义重情深

这是用AI写出来的代码，声明完变量还是不行
Sub 整列出车()
    '声明变量
    Dim wb As Workbook
    Dim ws1 As Worksheet    'YT-8出车及过表
    Dim ws2 As Worksheet    '部属车-YT-8
    Dim ws3 As Worksheet    '企业车-YT-8
    Dim lastRow As Long     '导入文件中工作表"第1页"的最后一行
    Dim ws As Worksheet
    Dim i As Long           '循环计数器
    Dim outCount As Long    '应出车辆数
    Dim carCount As Long    '出车辆数
    Dim deptCarCount As Long    '部属车成功出车辆数
    Dim entCarCount  As Long   '企业车成功出车辆数
    Dim notFoundCount As Long   '未查找到车号的数量
    Dim carNum As String    '导入文件中工作表"第1页"中的车号
    Dim rowFound As Boolean    '是否找到了匹配的行
    '初始化变量
    outCount = 0
    carCount = 0
    deptCarCount = 0
    entCarCount = 0
    notFoundCount = 0
    rowFound = False
    '调用文件选取器选择工作簿
    Path = Application.GetOpenFilename("Excel文件(*.xls;*.xlsx),*.xls;*.xlsx")
    If Path = "" Then
        MsgBox "请选择要导入数据文件!"
        Exit Sub
    End If
    Set wb = Workbooks.Open(Path)
    If wb Is Nothing Then GoTo endMacro
    Set ws1 = Worksheets("YT-8出车及过表")
    Set ws2 = Worksheets("部属车-YT-8")
    Set ws3 = Worksheets("企业车-YT-8")
    '获取导入文件中工作表"第1页"的最后一行
    Set ws = wb.Worksheets("第1页")
    With ws
        lastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
    End With
    '循环查找导入文件中工作表"第1页"中的每一行
    For i = 16 To lastRow
        carNum = wb.Worksheets("第1页").Cells(i, 4).Value   '获取车号
        '在部属车表中查找该车号,若找到则将信息填入
        Set rngFound = ws2.Range("D:D").Find(what:=carNum, LookIn:=xlValues)
        If Not rngFound Is Nothing Then
            deptCarCount = deptCarCount + 1
            ws2.Cells(rngFound.Row, 4) = ws1.Cells(2, 3).Value   '发出车次
            ws2.Cells(rngFound.Row, 5) = ws1.Cells(2, 4).Value   '发出日期
            ws2.Cells(rngFound.Row, 6) = ws1.Cells(2, 5).Value   '发出时间
            rowFound = True
        End If
        '在企业车表中查找该车号,若找到则将信息填入
        Set rngFound = ws3.Range("D:D").Find(what:=carNum, LookIn:=xlValues)
        If Not rngFound Is Nothing Then
            entCarCount = entCarCount + 1
            ws3.Cells(rngFound.Row, 4) = ws1.Cells(2, 3).Value
            ws3.Cells(rngFound.Row, 5) = ws1.Cells(2, 4).Value
            ws3.Cells(rngFound.Row, 6) = ws1.Cells(2, 5).Value
            rowFound = True
        End If
        '如果未找到,则未查找到车号数量+1
        If rowFound = False Then notFoundCount = notFoundCount + 1
    Next
    '显示执行结果
    Dim msg As String
    msg = "本次出车共导入" & outCount & "辆,实际成功出车" & (deptCarCount + entCarCount) & "辆(部属车" & deptCarCount & "辆,企业车" & entCarCount & "辆),未查找到车号" & notFoundCount
    MsgBox msg
endMacro:
End Sub

义重情深

自己顶一下！

zpy2

，继续向下查找直到该导入文件的工作表“第1页”的最后一行结束

非要这样查找吗？
能不能把1.xls的数据结构化后导入数据库查询呢？

义重情深

zpy2 发表于 2023-4-27 09:31
，继续向下查找直到该导入文件的工作表“第1页”的最后一行结束

非要这样查找吗？

一个是要考虑兼容性问题，很多电脑还是win7+excel07甚至还有XP+03的，之前也有个大神帮我改了个字典的方法，但是在一些电脑上是无法使用的

zpy2

义重情深 发表于 2023-4-27 10:00
一个是要考虑兼容性问题，很多电脑还是win7+excel07甚至还有XP+03的，之前也有个大神帮我改了个字典的方 ...

我是用在线工具的，只要是有浏览器就可以，手机端就可以玩了

义重情深

zpy2 发表于 2023-4-27 10:16
我是用在线工具的，只要是有浏览器就可以，手机端就可以玩了

是要在电脑上使用的，不允许连接外网

ykcbf1100

看了头晕，没搞懂。

义重情深

ykcbf1100 发表于 2023-4-27 11:28
看了头晕，没搞懂。

简单说就是从外部导入一张表-表3，然后在表1和表2里查找表3的号码，如果查找到，就把特定内容写到表1或表2