如果数据不存在，则添加到列表的底部

基本上我正在做一个excel文件，如果他们匹配，从这个工作簿复制到另一个值。 所以如果他们有相同的ID和“是”，那么一个字段被更新。 但是，在某些情况下，可能是工作簿中不存在该ID的ID复制到，但如果有“是”，我想将其添加到下一个空行。

以下是我到目前为止

Dim fpath As String Dim owb As Workbook Dim thisone As String Dim Siteref(1000) As String, siteref2(1000) As String, sitename(1000) As String, sitename2(1000) As String fpath = "my file path" Set owb = Application.Workbooks.Open(fpath) 'open location and file Dim Master As Worksheet 'declare both Dim Slave As Worksheet Set Slave = owb.Worksheets("Schedule") 'sheet in workbook im copying too Set Master = ThisWorkbook.Worksheets("Tbl_Primary") 'sheet from workbook im in For i = 1 To 1000 '(the slave sheet) 'for first 1000 cells For j = 1 To 1000 '(the master sheet) If Master.Cells(j, 2).Value = "" Then GoTo lastline End If ' if ID cell is blank jump to last line If Master.Cells(j, 2).Value = Slave.Cells(i, 1).Value And Master.Cells(j, 65).Value = "Yes" Then Slave.Cells(i, 4).Value = Master.Cells(j, 18).Value 'If the ID equals that in the slave sheet and there is a yes ticked the copy address End If lastline: Next Next MsgBox ("Data Transfer Successful") Application.DisplayAlerts = False ThisWorkbook.Worksheets("Tbl_Primary").Delete 'delete sheet Application.DisplayAlerts = True ThisWorkbook.Save ThisWorkbook.Close 'save and close it 

Answer 1

试试这个，让我知道如果它的工作。 我没有testing就盲目地写了。 所以，我不完全确定它会起作用：

 Dim bolFound As Boolean Dim lngLastRow As Long Dim fpath As String Dim owb As Workbook Dim Master As Worksheet 'declare both Dim Slave As Worksheet fpath = ActiveWorkbook.Path Set owb = Application.Workbooks.Open(fpath) 'open location and file Set Master = ThisWorkbook.Worksheets("Tbl_Primary") 'sheet from workbook im in Set Slave = owb.Worksheets("Schedule") 'sheet in workbook im copying too ' lngLastRow = Slave.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row For j = 1 To 1000 '(the master sheet) bolFound = False For i = 1 To 1000 '(the slave sheet) 'for first 1000 cells If Trim(Master.Cells(j, 2).Value2) = vbNullString Then Exit For 'if ID cell is blank jump to last line If Master.Cells(j, 2).Value = Slave.Cells(i, 1).Value And _ Master.Cells(j, 65).Value = "Yes" Then Slave.Cells(i, 4).Value = Master.Cells(j, 18).Value 'If the ID equals that in the slave sheet and there is a yes ticked the copy address bolFound = True End If Next If bolFound = False And _ Master.Cells(j, 65).Value = "Yes" Then Slave.Cells(lngLastRow, 4).Value = Master.Cells(j, 18).Value 'adding the new entry to the list lngLastRow = lngLastRow + 1 End If Next MsgBox ("Data Transfer Successful") Application.DisplayAlerts = False ThisWorkbook.Worksheets("Tbl_Primary").Delete 'delete sheet Application.DisplayAlerts = True ThisWorkbook.Save ThisWorkbook.Close 'save and close it 

Answer 2

未经testing。

 Dim fpath As String Dim owb As Workbook Dim thisone As String Dim Siteref(1000) As String, siteref2(1000) As String, sitename(1000) As String, sitename2(1000) As String Dim lastRow As Long fpath = "my file path" Set owb = Application.Workbooks.Open(fpath) 'open location and file Dim Master As Worksheet 'declare both Dim Slave As Worksheet Set Slave = owb.Worksheets("Schedule") 'sheet in workbook im copying to Set Master = ThisWorkbook.Worksheets("Tbl_Primary") 'sheet from workbook im in For i = 1 To 1000 '(the slave sheet) 'for first 1000 cells For j = 1 To 1000 '(the master sheet) If Master.Cells(j, 2).Value = "" Then Exit For End If ' if ID cell is blank jump to last line If Master.Cells(j, 2).Value = Slave.Cells(i, 1).Value And Master.Cells(j, 65).Value = "Yes" Then 'If the ID equals that in the slave sheet and there is a yes ticked the copy address Slave.Cells(i, 4).Value = Master.Cells(j, 18).Value End If If Master.Cells(j, 65).Value = "Yes" Then lastRow = Slave.Cells(ActiveSheet.Rows.Count, "D").End(xlUp).Row 'if yes found, copy value Slave.Cells(lastRow + 1, 4).Value = Master.Cells(j, 18).Value End If Next Next MsgBox ("Data Transfer Successful") Application.DisplayAlerts = False ThisWorkbook.Worksheets("Tbl_Primary").Delete 'delete sheet Application.DisplayAlerts = True ThisWorkbook.Save ThisWorkbook.Close 'save and close it