【问题标题】:VBA to import Excel worksheet, append new rows, and update existing rowsVBA 导入 Excel 工作表、追加新行和更新现有行
【发布时间】:2014-01-24 04:28:53
【问题描述】:

我正在使用 Excel 为支持票务系统生成报告,并且我想使用 VBA 来简化更新报告数据的过程。我想要做的是将一个从票务系统转储的 Excel 文件导入到我用于报告的 Excel 文件中,但有一点不同。我需要使用一列中的值来确定票是新的还是现有的。如果它是新的,我想将它添加到报告文件中。如果它存在,我想用导入的数据覆盖匹配的行(基于匹配的列值,即票号)。所以基本流程是:

  1. 打开导出的文件(我知道怎么做)
  2. 导出文件中的每一行
  3. 读取票号(A列)
  4. 在现有工作表列中搜索票号(也是 A 列)
  5. 如果找到,则将信息替换为导入的数据(B-X 列)
  6. 否则将导入的数据附加为新行(A-X 列)
  7. 下一行

上面的步骤 4-6 是我需要帮助的。我可以使用诸如 =NOT(ISNA(MATCH([imported ticket ID],[array of existing ticket IDs],0))) 之类的公式返回 TRUE 如果票证 ID 存在,如果不存在则为 FALSE,但如果存在,希望找到更优雅的解决方案。

这里有没有人有这样做的经验和/或一些我可以调整以适应我的目的的 VBA 代码?提前致谢。

编辑:这是我到目前为止的代码。不多。

Sub UpdateTickets()
'Specify data export file
Dim fNameAndPath As Variant
fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Processed")
If fNameAndPath = False Then Exit Sub
'Open data export file
Workbooks.Open Filename:=fNameAndPath
'For each row in data export file, starting at Row 2
'Check master data file (column A) for ticket number
'If ticket number exists, update information in columns B through P
'Else add new ticket row and place information in columns A through P
'Next row
End Sub

【问题讨论】:

  • 发布您当前的代码。
  • 编辑原帖以添加代码。

标签: vba excel import insert-update


【解决方案1】:

我刚刚写了这个,它成功了:

    Sub import_tickets()
        'run this when the active file is the main ticket list and the active sheet is the ticket list
        'exported file must be open already, and the ticket list must be the active sheet
        Dim exported_file As String
        exported_file = "exported file.xlsx"
        header_exists = True 'if exported file doesn't have a header, set this to false!
        starting_row = 1
        If header_exists Then starting_row = 2

        Dim first_blank_row As Long
        first_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row

        Dim r As Long
        r = starting_row
        Dim found As Range
        cur_ticket_num = Workbooks(exported_file).ActiveSheet.Range("a" & r).Value
        Do While Not cur_ticket_num = ""
            'look for current ticket number in main file
            Set found = Columns("a:a").Find(what:=cur_ticket_num, LookIn:=xlValues, lookat:=xlWhole)
            If found Is Nothing Then
                'add info to end of main file
                write_line_from_export exported_file, r, first_blank_row
                first_blank_row = first_blank_row + 1
            Else
                'overwrite existing line of main file
                write_line_from_export exported_file, r, found.Row
            End If
            r = r + 1
            cur_ticket_num = Workbooks(exported_file).ActiveSheet.Range("a" & r).Value
        Loop
    End Sub

    Sub write_line_from_export(src_filename As String, src_r As Long, dest_r As Long)
        For c = 1 To 24
            Cells(dest_r, c).Value = Workbooks(src_filename).ActiveSheet.Cells(src_r, c).Value
        Next c
    End Sub

我希望它有所帮助。我引用this page 作为第一个空白行代码,this page 作为查找代码。我在主工单文件的模块中编写了代码。

【讨论】:

  • 太棒了-谢谢!我测试了它,效果很好。我会带着它跑。
猜你喜欢
  • 2022-08-19
  • 1970-01-01
  • 1970-01-01
  • 2019-10-10
  • 2022-06-17
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多