VBA 售服任务跟踪表（涉及他表引用、字典、表格保护）

这个表格是按领导要求，当售服任务完成后，用于质检和财务进行持续跟踪登记的表格。
原本想按“发运后任务确认表”的模式进行开发，但发现引用的12#表，由于完成日期有先后，复制到“已完成”工作表后，序号不会进行有序排列，一进行排序，取的数据有会混乱。因此，通过字典功能，进行比对，取不存在的序号。

单元格底色是能过条件格式实现的

Sub GetData()
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim targetWorkbook As Workbook
    Dim targetWorksheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim rankrng As Range
    Dim myrange As Range
    Dim sheetName As String, path As String
    Dim ws As Worksheet
    Dim i As Long, j As Long, k As Long
    Dim scount As Long, tcount As Long, srow As Long, newcount As Long
    Dim slastrow As Variant, tlastrow As Variant
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
    Dim dic

'
     
'设置目标工作簿、工作表、范围
    Set targetWorkbook = ThisWorkbook
    Set targetWorksheet = targetWorkbook.Worksheets("任务数据")
    Set targetRange = targetWorksheet.Range("A" & tcount + 1)

    tcount = targetWorksheet.Range("A" & Rows.Count).End(xlUp).Row
    tlastrow = targetWorksheet.Range("A" & tcount).Value



   filepath = "\\192.168.100.5\生产中心\生产保障部"
'   filepath = ThisWorkbook.path
   
   f = Dir(filepath & "\12#售后配件任务单.xlsx")
    If f = "" Then
        MsgBox "源文件不存，请查看"
        Exit Sub
    Else
        Set sourceWorkbook = Workbooks.Open(filepath & "\" & f, Password:="chr", ReadOnly:=True)
    End If

    Set sourceWorksheet = sourceWorkbook.Worksheets("已完成")
    
'    如果源工作表有过滤，则显示所有数据
    If sourceWorksheet.FilterMode = True Then
     sourceWorksheet.ShowAllData
    End If
    '源数据最大行数及最大行序号值
    scount = sourceWorksheet.Range("A1").End(xlDown).Row
    slastrow = sourceWorksheet.Range("A" & scount).Value
    
    
    
    If scount = tcount Then
    
     '    关闭源工作簿，并不保存更改
          sourceWorkbook.Close SaveChanges:=False
        
'          ActiveSheet.Protect Password:="chr" '
        
          MsgBox "没有新增数据"
          
     Else
     


'方法之一，查询到相同的就删除，但速度很慢
'         For i = 1 To tcount
'          For j = 1 To scount
'           If ActiveSheet.Cells(i, 1).Value = sourceWorksheet.Cells(j, 1).Value Then
'              sourceWorksheet.Rows(i).Delete Shift:=xlUp
'           End If
'          Next j
'         Next i
         
''方法二，使用字典

    Set tarr = targetWorksheet.Range("A1:G" & tcount) '目标表范围
    Set sarr = sourceWorksheet.Range("A1:R" & scount) '源表范围

    Set dic = CreateObject("scripting.dictionary") '建字典

    For i = 2 To tcount
      dic(tarr.Cells(i, 1).Value) = ""  '将目标表第一列装入字典。固定格式取值，字典的Item值赋空值（因为这里不需要做任何一一对应的处理）
    Next
    
    ReDim arr(1 To scount, 1 To 9) '定义一个过渡区域ARR，使其行列数与源表一致
    
    k = 1
    For j = 2 To scount
       If Not dic.exists(sarr.Cells(j, 1).Value) Then  '字典中的值与源表中第一列的值对比，如果对不上就取下面相应的值赋到相应位置
            arr(k, 1) = sarr.Cells(j, 1) '序号
            arr(k, 2) = sarr.Cells(j, 2)  '单据编号
            arr(k, 3) = sarr.Cells(j, 3)  '售后编号
            arr(k, 4) = sarr.Cells(j, 4)  '客户
            arr(k, 5) = sarr.Cells(j, 5)  '任务类型
            arr(k, 6) = sarr.Cells(j, 6)  '任务内容
            arr(k, 7) = sarr.Cells(j, 7)  '任务主管
            arr(k, 8) = sarr.Cells(j, 15)  '实际完成日期
            arr(k, 9) = sarr.Cells(j, 16)  '物料配送日期
            k = k + 1
        End If
    Next
'关闭源文件
sourceWorkbook.Close SaveChanges:=False
'将arr中的内容复制到目标表格去
targetWorksheet.Cells(tcount, 1).Select
ActiveSheet.Range("A" & tcount).Offset(1, 0).Resize(k, 9) = arr


'新增数据加边框
newcount = ActiveSheet.Range("A1").End(xlDown).Row
Set myrange = ActiveSheet.Range("A" & tcount + 1 & ":L" & newcount)

' 为区域添加边框
With myrange.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
'行高
Rows(tcount + 1 & ":" & newcount).Select
Selection.RowHeight = 25


'单元格只读

ActiveSheet.Range("A" & tcount + 1 & ":I" & newcount).Locked = True

''


End If

'将第一行设置成筛选

If ActiveSheet.AutoFilterMode = False Then
 ActiveSheet.Range("A1:L1").AutoFilter
End If

'保护工作表
ActiveSheet.Protect Password:="chr" '

End Sub