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

义重情深

AI写的运行了以后，还是无效，不知道为什么明明提示导入成功，但是最后数据并没有写入
Sub 整列出车()
    Dim wbMain As Workbook
    Dim wsResult As Worksheet
    Dim wsDepartment As Worksheet
    Dim wsCompany As Worksheet
    Dim wsImport As Worksheet
    Dim wbImport As Workbook
    Dim lastRowImport As Long
    Dim lastRowDepartment As Long
    Dim lastRowCompany As Long
    Dim carNumber As String
    Dim i As Long, j As Long, k As Long
    Dim departmentCounter As Long
    Dim companyCounter As Long
    Dim notFoundCounter As Long
    Dim importFileDialog As FileDialog
   
    Set wbMain = ThisWorkbook
    Set wsResult = wbMain.Worksheets("YT-8出车及过表")
    Set wsDepartment = wbMain.Worksheets("部属车-YT-8")
    Set wsCompany = wbMain.Worksheets("企业车-YT-8")
   
    ' Select and open the imported Excel file
    Set importFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With importFileDialog
        .Title = "请选择需要导入的Excel文件"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel文件", "*.xls; *.xlsx; *.xlsm"
        If .Show = False Then Exit Sub
        Set wbImport = Workbooks.Open(.SelectedItems(1))
    End With
   
    Set wsImport = wbImport.Worksheets("第1页")
    lastRowImport = wsImport.Cells(wsImport.Rows.Count, "D").End(xlUp).Row
    lastRowDepartment = wsDepartment.Cells(wsDepartment.Rows.Count, "D").End(xlUp).Row
    lastRowCompany = wsCompany.Cells(wsCompany.Rows.Count, "D").End(xlUp).Row
   
    departmentCounter = 0
    companyCounter = 0
    notFoundCounter = 0
   
    Application.ScreenUpdating = False
   
    For i = 16 To lastRowImport
        carNumber = wsImport.Cells(i, "D").Value
        If carNumber <> "" Then
            For j = 2 To lastRowDepartment
                If wsDepartment.Cells(j, "D").Value = carNumber Then
                    wsDepartment.Cells(j, "O").Value = wsResult.Cells(2, "C").Value
                    wsDepartment.Cells(j, "P").Value = wsResult.Cells(2, "D").Value
                    wsDepartment.Cells(j, "Q").Value = wsResult.Cells(2, "E").Value
                    departmentCounter = departmentCounter + 1
                    Exit For
                End If
            Next j
            
            If j > lastRowDepartment Then
                For k = 2 To lastRowCompany
                    If wsCompany.Cells(k, "D").Value = carNumber Then
                        wsCompany.Cells(k, "O").Value = wsResult.Cells(2, "C").Value
                        wsCompany.Cells(k, "P").Value = wsResult.Cells(2, "D").Value
                        wsCompany.Cells(k, "Q").Value = wsResult.Cells(2, "E").Value
                        companyCounter = companyCounter + 1
                        Exit For
                    End If
                Next k
               
                If k > lastRowCompany Then
                    notFoundCounter = notFoundCounter + 1
                End If
            End If
        End If
    Next i
   
    Application.ScreenUpdating = True
   
    wbImport.Close SaveChanges:=False
   
    MsgBox "本次应出车" & (departmentCounter + companyCounter + notFoundCounter) & "辆，实际成功出车" & _
            (departmentCounter + companyCounter) & "辆（部属车" & departmentCounter & "辆，企业车" & companyCounter & _
            "辆），未查找到车号" & notFoundCounter & "辆。如有未查找到的车号，请确认运统8登记车号与出车编组是否一致。"
   
End Sub