【问题标题】:VBA matching and update existing and add new field into Next Empty Cell on next rowVBA匹配并更新现有并将新字段添加到下一行的下一个空单元格中
【发布时间】:2018-06-26 08:22:57
【问题描述】:

我是新来的,我正在尝试做一个 VBA Vlookup 功能。

我的目标是使用 A 列 VLookup Table1 从 Sheet 1 到 Sheet2 从 Sheet2 并更新列 B 和 C 如果 A 存在。

如果 A 不存在,则添加到 Table1 中的下一个空白行,其中 B 列和 C 列也包括在内。

请参考下图 - Sheet1 的预期更新结果。

提前谢谢你。

目前只能编写代码以更新现有字段,但不确定如何将不匹配的字段添加到 Sheet1 的下一个空白行中。

Sub getOpenExcel()

    '   Your daily report has a date in it's name
    '   to select an open workbook we must first know it's name
    '   AND - it must be already open
    '   Your examples are 2017-03-11-18875, 2017-03-12-18875, 2017-03-13-18875

    '   If the name is the current date then this would work to get the filename

    Dim fileName As String, monthNum As String, dayNum As String, wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, rng1 As Range, rng2 As Range

    '   this adds a ZERO to the front of month numbers less than 10
    If Month(Date) < 10 Then
        monthNum = "0" & CStr(Month(Date))
    Else
        monthNum = CStr(Month(Date))
    End If


    '   You may or may not need this section
    '   it adds a ZERO to the front of day numbers less than 10
    If Day(Date) < 10 Then
        dayNum = "0" & CStr(Day(Date))
    Else
        dayNum = CStr(Day(Date))
    End If
    '   many cases the daily report will come from the previous day
    '   If your file has yesterday's date, then comment out the above code and
    'uncomment the following code
    '
    'If Day(DateAdd("d", -1, Date)) < 10 Then
    '    dayNum = "0" & Day(DateAdd("d", -1, Date))
    'Else
    '    dayNum = Day(DateAdd("d", -1, Date))
    'End If


    fileName = "GREENBILL_RECON_DETAILED_REPORT_" & CStr(Year(Date)) & monthNum & dayNum
    '   if today's date is 3/14/17 then "fileNem" = "2017-03-12-18875"

    '   If your daily report is an excel book, then we need to add the proper extension.
    '   It could be one of many, "xls", ".xlsx" , ".xlsm", etc....
    '   If your daily report is open - look at the top.  It should have the file name and extension.'
    '   Replace the below extension with the correct one.
    fileName = fileName & ".csv"
    '   Again, if today's date is 3/14/17 then "fileNem" =  "2017-03-12-18875.xlsx"


    '   This is where we set both workbooks to variables
    '
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("Sheet1")

    On Error GoTo notOpen
    Set wb2 = Workbooks(fileName)                ' This is your daily report
    On Error GoTo 0
    Set ws2 = wb2.Worksheets("GREENBILL_RECON_DETAILED_REPORT")
    ws1.Activate
    '*************************************************************************************
    ' If successful this is the area where you put your code to copy and paste automatically '
    ' If you need this pasted to the first empty row at bottom of page then 'put code here to find the first empty row and use that varaible
    ' with range("a" & firstUnusedRow) intstead of A1 ...

    wb2.Activate
    Range("A1:Z500").Copy _
          Destination:=wb1.Worksheets("Sheet1").Range("A1") 'change A1 to A &
    firstUnusedRow
    '*************************************************************************************
    ' This is the clean up and exit code

    Set wb1 = Nothing
    Set wb2 = Nothing
    Exit Sub
notOpen:
    On Error GoTo 0
    Set wb1 = Nothing
    MsgBox "The file " & fileName & " is not open"
    Exit Sub

End Sub

Sub Rectangle3_Click()

    On Error Resume Next

    Dim Dept_Row As Long                         ' To Change to Billing_Acc
    Dim Dept_Clm As Long                         ' To Change to Org_Seqno

    Table1 = Sheet1.Range("A1:A10")              ' Input file name
    Table2 = Sheet2.Range("A1:B10")              ' Range of table

    Dept_Row = Sheet1.Range("B1").Row
    Dept_Clm = Sheet1.Range("B1").Column

    For Each cl In Table1
        Sheet1.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
        Dept_Row = Dept_Row + 1
    Next cl
    MsgBox "Done"

End Sub

【问题讨论】:

  • 我的意思不是听起来粗鲁,但是……你刚刚描述了你需要做什么以及你需要如何去做,所以你为什么不直接去做…… ?
  • 嗨@Rawrplus,我需要每天更新列表,并生成一个没有旧字段的新工作表。因此我需要这个逻辑。我已经创建了用于更新列 B 和 C 的 VBA,但我不确定如何将逻辑添加到 VBA 中以将 A 中未找到的字段添加到 Sheet1 的下一个空白行中。谢谢。
  • 这一切都很好,花花公子。尽管如此,我的主要观点是 - 它在这里的工作方式是你应该发布你目前的努力。理想情况下,这意味着您当前工作的代码。这个地方专门帮助你编写代码,而不是为你编写代码:)
  • @Rawrplus,感谢您向我解释。我将代码复制过来。
  • 我仍然不清楚该算法应该如何工作。我的意思是,我知道您基本上想将两张桌子融合成一张大桌子,但我不清楚这里的主要概念是什么。如果我做对了,您首先遍历表一,如果值在表 2 中,则表 2 值被发布,然后您只需添加两个表中未包含的额外值? 请尝试用时尚之类的算法描述您对预期结果的计算

标签: vba excel match vlookup


【解决方案1】:

下面的代码通过匹配两张表的 A 列来遍历所有行。如果没有找到,这将在 sheet1 中添加一个新行。

Dim lngRow1, lngRow2 As Long
lngRow1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lngRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

Dim isFound As Boolean
Dim lastRow As Long
Dim i, j As Long

lastRow = lngRow1
For i = 1 To lngRow2
    isFound = False
    For j = 1 To lngRow1
        If Sheets("Sheet1").Range("A" & i) = Sheets("Sheet2").Range("A" & j) Then
            Sheets("Sheet1").Range("B" & i) = Sheets("Sheet2").Range("B" & j)
            Sheets("Sheet1").Range("C" & i) = Sheets("Sheet2").Range("C" & j)
            isFound = True
        End If
    Next j
    If Not isFound Then
        lastRow = lastRow + 1
        Sheets("Sheet1").Range("A" & lastRow) = Sheets("Sheet2").Range("A" & i)
        Sheets("Sheet1").Range("B" & lastRow) = Sheets("Sheet2").Range("B" & i)
        Sheets("Sheet1").Range("C" & lastRow) = Sheets("Sheet2").Range("C" & i)
    End If
Next i

考虑上述示例图像编写的代码。如果列数与示例不同,请相应地修改代码。

【讨论】:

  • 天哪,感谢 Nagarajan。你是生命的救星。感谢您的帮助。
  • 是否可以设置任何验证,就像我多次单击按钮一样,“Fin”将在彼此下方重复多次。当我向 Sheet2 添加其他行字段时,这些字段不会被复制到 Sheet1。
猜你喜欢
  • 1970-01-01
  • 2017-08-08
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多