2个表格对比，筛选、删除数据

最新推荐文章于 2022-12-27 17:29:18 发布

l_iu_xing

最新推荐文章于 2022-12-27 17:29:18 发布

阅读量207

点赞数

分类专栏： VBA

本文链接：https://blog.csdn.net/l_iu_xing/article/details/119537889

版权

VBA 专栏收录该内容

13 篇文章 1 订阅

订阅专栏

2个表格对比，筛选、删除数据

Option Explicit

Sub search()
'Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~"
'变量声明
Dim File_sum, Sum_Workbook, i, j, sum, name_song_3, name_song_5, phone_3, phone_5

   '-----------------------------------------------------------------
   
'打开文件
    '打开汇总表格     '^^^^^^
 File_sum = "E:\LG Files\2021\8月\童谣作品\信息匹配.xlsm"  
 Set Sum_Workbook = GetObject(File_sum)

 sum = 0
 Sum_Workbook.Worksheets(5).UsedRange.ClearFormats
 
                For i = 1 To Sum_Workbook.Worksheets(5).UsedRange.Rows.Count
                        For j = 1 To Sum_Workbook.Worksheets(3).UsedRange.Rows.Count

                                name_song_3 = Mid(Sum_Workbook.Worksheets(3).UsedRange.Cells(j, 2), 1, 2)
                                name_song_5 = Mid(Sum_Workbook.Worksheets(5).UsedRange.Cells(i, 2), 1, 2)
                                
                                phone_3 = Right(Sum_Workbook.Worksheets(3).UsedRange.Cells(j, 6), 4)
                                phone_5 = Right(Sum_Workbook.Worksheets(5).UsedRange.Cells(i, 6), 4)
                                
                                
                                If name_song_3 = name_song_5 And phone_3 = phone_5 Then
                                    
                                    Sum_Workbook.Worksheets(5).UsedRange.Rows(i).Clear
                                    
                                    sum = sum + 1
                                    Debug.Print Sum_Workbook.Worksheets(3).UsedRange.Cells(i, 2)
                                    Exit For
                                End If
                                '-------------*******------------------
                        Next '
                Next '---

    For i = Sum_Workbook.Worksheets(5).UsedRange.Rows.Count To 1 Step -1
        If Sum_Workbook.Worksheets(5).UsedRange.Cells(i, 2) = "" Then
            
            Sum_Workbook.Worksheets(5).UsedRange.Cells(i, 1).EntireRow.Delete shift:=xlShiftUp 'xlShiftToLeft

        End If
    Next

    Debug.Print "匹配完成！" & sum
End Sub