VBA实现覆盖导入：根据关键字删除和导入数据

VBA 实现覆盖导入：根据关键字删除和导入数据

本文将介绍如何使用 VBA 代码实现覆盖导入功能，并根据指定关键字删除目标工作表中的相关行，并将数据源工作簿中包含该关键字的行导入到目标工作表。

1. 基本覆盖导入

首先，我们介绍基本的覆盖导入功能，代码如下：

Sub ImportData()
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Set wbSource = Workbooks.Open('C:\SourceWorkbook.xlsx')
    Set wsTarget = ThisWorkbook.Sheets('TargetSheet')
    wbSource.Sheets('SourceSheet').UsedRange.Copy
    wsTarget.Range('A1').PasteSpecial xlPasteValues
    wbSource.Close False
End Sub

该代码将 SourceWorkbook.xlsx 文件中的 SourceSheet 工作表中的数据复制到当前工作簿的 TargetSheet 工作表中，并覆盖原有数据。

2. 只覆盖指定列含有指定内容

要实现只覆盖指定列含有指定内容的功能，可以使用条件语句。例如，假设要覆盖目标工作表中的第一列 (A 列) 中包含 'Apple' 的单元格，可以使用以下代码：

Sub ImportData()
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Set wbSource = Workbooks.Open('C:\SourceWorkbook.xlsx')
    Set wsTarget = ThisWorkbook.Sheets('TargetSheet')
    For Each cell In wsTarget.Range('A1:A' & wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row)
        If cell.Value = 'Apple' Then
            wbSource.Sheets('SourceSheet').Cells(cell.Row, 1).Copy
            wsTarget.Cells(cell.Row, 1).PasteSpecial xlPasteValues
        End If
    Next cell
    wbSource.Close False
End Sub

该代码遍历目标工作表中的第一列单元格，如果单元格的值为 'Apple'，则将源工作表中对应单元格的值复制到目标工作表中。

3. 指定内容改为可以手动输入

可以使用 VBA 中的 InputBox 函数实现手动输入关键字的功能。以下代码将目标工作表中第一列 (A 列) 中包含用户输入的关键字的单元格覆盖为源工作表中对应单元格的值：

Sub ImportData()
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Dim keyword As String
    keyword = InputBox('请输入要覆盖的关键字：')
    Set wbSource = Workbooks.Open('C:\SourceWorkbook.xlsx')
    Set wsTarget = ThisWorkbook.Sheets('TargetSheet')
    For Each cell In wsTarget.Range('A1:A' & wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row)
        If cell.Value = keyword Then
            wbSource.Sheets('SourceSheet').Cells(cell.Row, 1).Copy
            wsTarget.Cells(cell.Row, 1).PasteSpecial xlPasteValues
        End If
    Next cell
    wbSource.Close False
End Sub

4. 删除本工作表包含关键字的所有行，导入数据源工作带有关键字的所有行

以下代码将删除目标工作表中包含关键字的所有行，并将数据源工作簿中带有关键字的所有行导入到目标工作表中：

Sub ImportData()
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Dim keyword As String
    Dim lastRow As Long
    Dim i As Long
    keyword = InputBox('请输入要覆盖的关键字：')
    Set wbSource = Workbooks.Open('C:\SourceWorkbook.xlsx')
    Set wsTarget = ThisWorkbook.Sheets('TargetSheet')
    lastRow = wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row
    For i = lastRow To 1 Step -1
        If InStr(1, wsTarget.Cells(i, 1).Value, keyword) > 0 Then
            wsTarget.Rows(i).Delete
        End If
    Next i
    lastRow = wbSource.Sheets('SourceSheet').Cells(wbSource.Sheets('SourceSheet').Rows.Count, 'A').End(xlUp).Row
    For i = 1 To lastRow
        If InStr(1, wbSource.Sheets('SourceSheet').Cells(i, 1).Value, keyword) > 0 Then
            wsTarget.Rows(wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row + 1).Value = wbSource.Sheets('SourceSheet').Rows(i).Value
        End If
    Next i
    wbSource.Close False
End Sub

5. 判断指定列是否带有关键字

以下代码判断目标工作表指定列是否带有关键字，如果是，则删除包含关键字的行并导入数据源工作簿中包含关键字的行；否则直接在目标工作表最底一行导入数据源工作簿从第二行开始到最后一行的数据：

Sub ImportData()
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Dim keyword As String
    Dim lastRow As Long
    Dim i As Long
    keyword = InputBox('请输入要覆盖的关键字：')
    Set wbSource = Workbooks.Open('C:\SourceWorkbook.xlsx')
    Set wsTarget = ThisWorkbook.Sheets('TargetSheet')
    If wsTarget.Range('A1').Value = '指定列标题' Then
        lastRow = wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row
        For i = lastRow To 1 Step -1
            If InStr(1, wsTarget.Cells(i, 'A').Value, keyword) > 0 Then
                wsTarget.Rows(i).Delete
            End If
        Next i
        lastRow = wbSource.Sheets('SourceSheet').Cells(wbSource.Sheets('SourceSheet').Rows.Count, 'A').End(xlUp).Row
        For i = 2 To lastRow
            If InStr(1, wbSource.Sheets('SourceSheet').Cells(i, 'A').Value, keyword) > 0 Then
                wsTarget.Rows(wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row + 1).Value = wbSource.Sheets('SourceSheet').Rows(i).Value
            End If
        Next i
    Else
        lastRow = wbSource.Sheets('SourceSheet').Cells(wbSource.Sheets('SourceSheet').Rows.Count, 'A').End(xlUp).Row
        wsTarget.Rows(wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row + 1).Resize(lastRow - 1, wbSource.Sheets('SourceSheet').Columns.Count).Value = wbSource.Sheets('SourceSheet').Range('A2').Resize(lastRow - 1, wbSource.Sheets('SourceSheet').Columns.Count).Value
    End If
    wbSource.Close False
End Sub

6. 指定列为 A 列内容

要将代码中的指定列改为 A 列，只需将代码中的 Range('A1') 和 Cells(i, 1) 中的数字 1 改为字母 'A'，即 Range('A1') 和 Cells(i, 'A')。例如：

Sub ImportData()
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Dim keyword As String
    Dim lastRow As Long
    Dim i As Long
    keyword = InputBox('请输入要覆盖的关键字：')
    Set wbSource = Workbooks.Open('C:\SourceWorkbook.xlsx')
    Set wsTarget = ThisWorkbook.Sheets('TargetSheet')
    If wsTarget.Range('A1').Value = '指定列标题' Then
        lastRow = wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row
        For i = lastRow To 1 Step -1
            If InStr(1, wsTarget.Cells(i, 'A').Value, keyword) > 0 Then
                wsTarget.Rows(i).Delete
            End If
        Next i
        lastRow = wbSource.Sheets('SourceSheet').Cells(wbSource.Sheets('SourceSheet').Rows.Count, 'A').End(xlUp).Row
        For i = 2 To lastRow
            If InStr(1, wbSource.Sheets('SourceSheet').Cells(i, 'A').Value, keyword) > 0 Then
                wsTarget.Rows(wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row + 1).Value = wbSource.Sheets('SourceSheet').Rows(i).Value
            End If
        Next i
    Else
        lastRow = wbSource.Sheets('SourceSheet').Cells(wbSource.Sheets('SourceSheet').Rows.Count, 'A').End(xlUp).Row
        wsTarget.Rows(wsTarget.Cells(wsTarget.Rows.Count, 'A').End(xlUp).Row + 1).Resize(lastRow - 1, wbSource.Sheets('SourceSheet').Columns.Count).Value = wbSource.Sheets('SourceSheet').Range('A2').Resize(lastRow - 1, wbSource.Sheets('SourceSheet').Columns.Count).Value
    End If
    wbSource.Close False
End Sub

以上代码示例展示了 VBA 代码实现覆盖导入功能的多种方法，您可以根据自己的需求进行修改和调整。

注意： 在使用代码之前，请确保您已经备份了目标工作簿。