vba 将数据从一张纸比较和复制到另一张需要很长时间的宏
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24998958/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Macro to compare and copy data from one sheet to another taking a long time
提问by Rahul Nair
I used this macro to copy contents from one Excel sheet to another, by comparing two columns and finding a matching cell. The problem is that this macro is taking a long time (close to three days) to complete. There are close to 4,00,000 records in both the sheets to compare against.
通过比较两列并找到匹配的单元格，我使用此宏将内容从一个 Excel 工作表复制到另一个 Excel 工作表。问题是这个宏需要很长时间（接近三天）才能完成。两张表中都有近 4,00,000 条记录可供比较。
Can someone please help me to make things faster?
有人可以帮我加快速度吗？
Option Explicit
Sub MatchAndCopy()
Dim sheet01 As Worksheet, sheet02 As Worksheet
Dim count As Range, matchingCell As Long
Dim RangeInSheet1 As Variant
Dim RangeInSheet2 As Variant
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Set sheet01 = Worksheets("Sheet1")
Set sheet02 = Worksheets("Sheet2")
Set RangeInSheet1 = sheet01.Columns(1)
Set RangeInSheet2 = sheet02.Range("A2", sheet02.Range("A" & Rows.count).End(xlUp))
For Each count In RangeInSheet2
matchingCell = 0
On Error Resume Next
matchingCell = Application.Match(count, RangeInSheet1, 0)
On Error GoTo 0
If matchingCell <> 0 Then
Application.StatusBar = "Please wait while data is being copied, Processing count : " & count
sheet01.Range("F" & matchingCell).Value = count.Offset(, 1)
sheet01.Range("G" & matchingCell).Value = count.Offset(, 2)
sheet01.Range("H" & matchingCell).Value = count.Offset(, 3)
sheet01.Range("I" & matchingCell).Value = count.Offset(, 4)
sheet01.Range("J" & matchingCell).Value = count.Offset(, 5)
End If
Next count
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
回答by Tim Williams
Should be faster:
应该更快：
Sub MatchAndCopy()
Dim sheet01 As Worksheet, sheet02 As Worksheet
Dim c As Range, matchingCell As Long
Dim RangeInSheet1 As Range
Dim RangeInSheet2 As Range
Dim dict As Object, tmp
Set dict = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Set sheet01 = Worksheets("Sheet1")
Set sheet02 = Worksheets("Sheet2")
Set RangeInSheet1 = sheet01.Range(sheet01.Range("A2"), _
sheet01.Cells(Rows.count, 1).End(xlUp))
Set RangeInSheet2 = sheet02.Range(sheet02.Range("A2"), _
sheet02.Cells(Rows.count, 1).End(xlUp))
'populate dictionary...
For Each c In RangeInSheet1.Cells
tmp = c.Value
If Not dict.exists(tmp) Then
dict.Add tmp, c.Row
End If
Next c
For Each c In RangeInSheet2.Cells
tmp = c.Value
If dict.exists(tmp) Then
Application.StatusBar = "Please wait while data is being copied," & _
" Processing count : " & c.Row
sheet01.Cells(dict(tmp), "F").Resize(1, 5).Value = _
c.Offset(0, 1).Resize(1, 5).Value
End If
Next c
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
回答by Zev Spitz
For 4 million records between the two sheets, use a database. Excel is not a database.
对于两张工作表之间的 400 万条记录，请使用数据库。Excel 不是数据库。
If you insist on treating Excel as a database, I would suggest using ADODB. See this answerfor a similar problem and solution.
如果您坚持将 Excel 视为数据库，我建议您使用 ADODB。有关类似问题和解决方案，请参阅此答案。
Name each of the columns on Sheet1 that you want to write to, by putting the name in the first row of each column. For the example, let's call them F1,F2,F3,F4and F5. Also, name the column with the shared data between Sheet1 and Sheet2; for the example we'll call it F0.
通过将名称放在每列的第一行，命名 Sheet1 上要写入的每一列。对于这个例子，让我们给他们打电话 F1，F2，F3，F4和F5。另外，命名包含 Sheet1 和 Sheet2 之间共享数据的列；对于这个例子，我们称之为F0。
Then, if your version of Office allows it, you can issue this statement:
然后，如果您的 Office 版本允许，您可以发出以下声明：
UPDATE [Sheet1$]
INNER JOIN [Sheet2$] ON [Sheet1$].F0 = [Sheet2$].F0
SET
[Sheet1$].F1 = [Sheet2$].F1,
[Sheet1$].F2 = [Sheet2$].F2,
[Sheet1$].F3 = [Sheet2$].F3,
[Sheet1$].F4 = [Sheet2$].F4,
[Sheet1$].F5 = [Sheet2$].F5
If not, you can use the CopyFromRecordset method with the recordset generated from the following SQL statement:
如果没有，您可以对从以下 SQL 语句生成的记录集使用 CopyFromRecordset 方法：
SELECT s1.F0,
Iif(s2.F0 Is Not Null, s2.F1, s1.F1),
Iif(s2.F0 Is Not Null, s2.F2, s1.F2),
Iif(s2.F0 Is Not Null, s2.F3, s1.F3),
Iif(s2.F0 Is Not Null, s2.F4, s1.F4),
Iif(s2.F0 Is Not Null, s2.F5, s1.F5)
FROM [Sheet1$] AS s1
LEFT JOIN [Sheet2$] AS s2 ON s1.F0 = s2.F0
回答by SoftwareTester
Get the whole sheet at once using
使用一次获取整个工作表
var values = sheet.getDataRange().getValues();
and compare values locally
并在本地比较值
EDIT-1
Google Apps script documentation https://developers.google.com/apps-script/reference/spreadsheet/spreadsheetprovides the following example for getDataRange()
EDIT-1
Google Apps 脚本文档https://developers.google.com/apps-script/reference/spreadsheet/spreadsheet为 getDataRange() 提供了以下示例
Returns a Range corresponding to the dimensions in which data is present. This is functionally equivalent to creating a Range bounded by A1 and (Range.getLastColumn(), Range.getLastRow()).
var ss = SpreadsheetApp.getActiveSpreadsheet();
var sheet = ss.getSheets()[0];
// This represents ALL the data
var range = sheet.getDataRange();
var values = range.getValues();
// This logs the spreadsheet in CSV format with a trailing comma
for (var i = 0; i < values.length; i++) {
var row = "";
for (var j = 0; j < values[i].length; j++) {
if (values[i][j]) {
row = row + values[i][j];
}
row = row + ",";
}
Logger.log(row);
}
Instead of using a lot of ranges, data should be obtained in ONE call and processed locally
不应使用大量范围，而应在 ONE 调用中获取数据并在本地处理
