Vba 复制文件一页中的行，并根据条件更新另一文件另一页中的行
我有一个fileFrom.xls，其中有一个表，该表包含数据，该数据将被更新为另一个文件to.xls，该文件包含表 Exmaple： “From”工作表的From.xls文件中包含以下数据Vba 复制文件一页中的行，并根据条件更新另一文件另一页中的行,vba,Vba,我有一个fileFrom.xls，其中有一个表，该表包含数据，该数据将被更新为另一个文件to.xls，该文件包含表 Exmaple： “From”工作表的From.xls文件中包含以下数据 Sno Name Assigned Staus Delivered Date Account No 100 Packet 1 Team 1 Delivered Yes 12-Dec-12 001 101 Packet 2 Team 1 Delivered
Sno Name Assigned Staus Delivered Date Account No
100 Packet 1 Team 1 Delivered Yes 12-Dec-12 001
101 Packet 2 Team 1 Delivered Yes 12-Dec-12 003
103 Packet 4 Team 2 Not Delivered No 003
105 Packet 6 Team 2 Delivered Yes 12-Dec-12 001
110 Packet 11 Team 2 Delivered Yes 12-Dec-12 002
111 Packet 12 Team 2 Not Delivered No 002
112 Packet 13 Team 2 Delivered Yes 12-Dec-12 001
115 Packet 16 Team 2 Delivered Yes 12-Dec-12 001
116 Packet 17 Team 11 Not Delivered No 002
Sno Name Assigned Staus Delivered Date Account No
100 Packet 1 Team 1 No
101 Packet 2 Team 1 No
102 Packet 3 Team 3 No
103 Packet 4 Team 2 No
104 Packet 5 Team 5 No
105 Packet 6 Team 2 No
106 Packet 7 Team 7 No
107 Packet 8 Team 8 No
108 Packet 9 Team 9 No
109 Packet 10 Team 10 No
110 Packet 11 Team 2 No
111 Packet 12 Team 2 No
112 Packet 13 Team 2 No
113 Packet 14 Team3 No
114 Packet 15 Team4 No
115 Packet 16 Team 2 No
116 Packet 17 Team 11 No
117 Packet 18 Team7 No
118 Packet 19 Team8 No
Sno Name Assigned Staus Delivered Date Account No
100 Packet 1 Team 1 Delivered Yes 12-Dec-12 001
101 Packet 2 Team 1 Delivered Yes 12-Dec-12 003
102 Packet 3 Team 3 No
103 Packet 4 Team 2 Not Delivered No 003
104 Packet 5 Team 5 No
105 Packet 6 Team 2 Delivered Yes 12-Dec-12 001
106 Packet 7 Team 7 No
107 Packet 8 Team 8 No
108 Packet 9 Team 9 No
109 Packet 10 Team 10 No
110 Packet 11 Team 2 Delivered Yes 12-Dec-12 002
111 Packet 12 Team 2 Not Delivered No 002
112 Packet 13 Team 2 Delivered Yes 12-Dec-12 001
113 Packet 14 Team3 No
114 Packet 15 Team4 No
115 Packet 16 Team 2 Delivered Yes 12-Dec-12 001
116 Packet 17 Team 11 Not Delivered No 002
117 Packet 18 Team7 No
118 Packet 19 Team8 No
这是一个有点难读，我想很容易回答，如果我理解你的权利。尽量把一切都弄清楚。如果Sno已经交付，您要求复制粘贴数据的是什么？排成一排吗？往返的Sno 100、101等是否相同？Sno是按顺序出现的，还是必须搜索它们 如果需要进行搜索，您可能希望使用vba进行搜索，尽管对于这样简单的事情，一些VLOOKUPs和IFs也可以在计算单元中完成搜索 复制粘贴条件究竟是什么？我相信这是可以解决的 编辑-示例代码：
Option Explicit
Sub CopyData()
const FIRST_ROW_FROM as Long 1 'Put the first row of the data in From
const LAST_ROW_FROM as Long = 4 'Put the last row of the data in From
const SNO_COL_FROM as Long = 1 'Put the column of the sno in From
const FIRST_ROW_TO as Long 1 'Put the first row of the data in To
const LAST_ROW_TO as Long = 4 'Put the last row of the data in To
const SNO_COL_TO as Long = 1 'Put the column of the sno in To
const NUM_COLS as long = 5 'Number of columns of data
Dim rowCounter as Long
Dim searchVal as String
Dim fileName as String
Dim errHappened as Bool = False
Dim foundCell as Range
Dim xlApp as Excel.Application
Dim fromBook as Workbook
Dim toBook as Workbook
Dim fromSheet as Worksheet
Dim toSheet as Worksheet
'Remove the comment mark (') below if you want the program to exit silently on an error
'On Error Resume Next
set xlApp = CreateObject("Excel.Application")
If xlApp is Nothing Then
errHappened = True
GoTo CleanUp
End If
'From
'make these xlsx or xlsm if that is what they are
fileName = Application.GetOpenFileName("Excel Workbooks, *.xls", "Select the From File")
If Instr(fileName, "From.xls") = 0 Then
errHappened = True
Goto CleanUp
End If
Set fromBook = xlApp.Open(fileName)
If fromBook is Nothing Then
errHappened = True
GoTo CleanUp
Endif
'To
fileName = Application.GetOpenFileName("Excel Workbooks, *.xls", "Select the To File")
If Instr(fileName, "To.xls") = 0 Then
errHappened = True
GoTo CleanUp
End If
Set toBook = xlApp.Open(fileName)
If toBook is Nothing Then
errHappened = True
GoTo CleanUp
Endif
Set fromSheet = fromBook.Worksheets("From")
Set toSheet = toBook.Worksheets("To")
If (fromSheet is Nothing) Or (toSheet is Nothing) Then
errHappened = True
GoTo CleanUp
End If
For rowCounter = FIRST_ROW_FROM to LAST_ROW_FROM
searchVal = fromSheet.Cells(rowCounter, SNO_COL_FROM)
Set foundCell = Nothing
Set foundCell = toSheet.Range(toSheet.Cells(FIRST_ROW_TO, SNO_COL_TO), toSheet.Cells(LAST_ROW_TO, SNO_COL_TO) ).Find(searchVal,, xlValues, xlWhole)
If foundCell is Nothing Then
errHappened = True
MsgBox("Could Not Find Sno " & searchVal & " in To.xls from row " & Cstr(rowCounter) & " in From.")
Else
fromSheet.Range(fromSheet.Cells(rowCounter, SNO_COL_FROM), fromSheet.Cells(rowCounter, SNO_COL_FROM + NUM_COLS -1 )).Copy
foundCell.PasteSpecial Paste:= xlPasteAll
End If
Next rowCounter
'If you feel comfortable with the results, you can uncomment toBook.Save here and get rid of the
'Safe Ending below. Delete from Begin Safe Ending to End Safe Ending
'toBook.Save
'''''Begin Safe Ending
'Makes worksheets visible so that you can verify you are happy with the results. If you are,
'save it. Otherwise, close without saving. I will not take responsibility for a Sub that
'Overwrites your files, so I am giving you the Safe Ending!
xlApp.Visible = True
Exit Sub
'''''End Safe Ending
CleanUp:
If Not fromBook is Nothing then
fromBook.Saved = True
fromBook.Close
End If
If Not toBook is Nothing then
toBook.Saved = True
toBook.Close
End If
If Not xlApp is Nothing Then
xlApp.Close
End If
If errHappened Then
MsgBox("There was an error",, "Error")
End If
End Sub
我在Mac上写的，所以它没有经过测试！！！请花点时间在中断模式下运行代码并验证其完整性。是否有任何方法可以共享一个有详细解释的文档。从fromsheetfrom.xls，我必须根据sno将数据更新到tosheetto.xls。两张表具有相同的列。例如，在from sheet中，sno列100102103108中只有4行按顺序，这些应根据sno更新到工作表中。在to工作表中，我们将有sno列100101102103104105106107108109110。因此，只有100102103108 in to工作表从工作表中得到更新表单，并且工作表中的其余行相同。这应通过单击按钮完成。是否清楚？？