匹配在Excel VBA中的两个数据列表,并导出到新表
我收到一个excel文件月并有它的部分导出到一个新的文件。我有一个标识符号码列表,我试图将选定列表中的数字列表与完整文件进行匹配,然后将相关数据的行导出到新表格中。匹配在Excel VBA中的两个数据列表,并导出到新表
Sub Run_All_Macros()
Application.ScreenUpdating = False
Sheets.Add.Name = "Output"
Call Convert_to_Numbers
Call Highlight_Selected_Contractors
End Sub
'Original Spreadsheet is formatted incorrectly
'Convert PSD Codes to Numbers
Sub Convert_to_Numbers()
Dim xCell As Range
Range("A2:A2500").Select
For Each xCell In Selection
xCell.Value = CDec(xCell.Value)
Next xCell
End Sub
'Highlight Selected Contractors
Sub Highlight_Selected_Contractors()
Dim Full, Selection, Code, SelectedCode As Range
Worksheets("Sheet1").Select
'Set all cells in Column A Sheet 1 to Full
Set Full = Worksheets("Sheet1").Range("A1", Range("A1").End(xlDown))
'Set all cells in Column A Sheet 2 to Selection
Worksheets("Sheet2").Select
Set Selection = Worksheets("Sheet2").Range("A1", Range("A1").End(xlDown))
'If the numbers match highlight the cell
For Each Code In Full
For Each SelectedCode In Selection
If Code.Value = SelectedCode.Value Then
*** Code.Select
Selection.Copy
Sheets.Select ("Output")
ActiveSheet.Paste
End If
Next SelectedCode
Next Code
End Sub
在执行此代码后,“输出”中的列A填充了A2:A2500中的零。从弄乱断点,我发现问题是我已经放置的地方*但我不确定那里写的是什么问题。
谢谢
在上面的代码几乎没有错误,我也有几点建议,最后是代码。
错误
1)Sheets.Add.Name = "Output"
此行会给你一个错误,如果已经有一个名为“输出继电器”表。先删除工作表然后创建它。您一定想知道,如果该表不存在,那我该如何删除它?对于这种情况,您可以使用On Error Resume Next
,这在大多数情况下应该避免。
2)使用范围时,总是指定您引用的是哪个工作表,否则Excel将始终假定您指的是“ActiveSheet”。当你意识到Sub Convert_to_Numbers()
正在考虑Output
表,而你希望操作发生在“输出”表。
3)Dim Full, Selection, Code, SelectedCode As Range
正如我在前面的评论中提到的,避免使用Excel保留字作为变量。与VB.Net不同的是,如果您像在VBA中那样声明变量,那么只会将最后一个变量声明为Range
。其他3将被宣布为变体。 VB默认变量是类型Variant。 Variant类型变量可以保存任何类型的数据,从字符串,整数,长整数,日期到货币等。默认情况下,“变量”是“最慢”类型的变量。变体也应该避免,因为它们是造成可能的“类型不匹配错误”的原因。这并不是说我们不应该使用变体。只有在您不确定代码执行的可能性时才应该使用它们。
4)避免使用的话像.ActiveCell
,Selection
,Select
,Activate
等,他们是错误的主要原因。他们也减慢你的代码。
SUGGESTIONS
1)代替使用表( “不管”)每一次,其存储在一个变量,然后使用该变量。将减少你的代码。
2)缩进你的代码:)它更容易阅读
3)组任务一起。例如,如果您必须处理某个特定工作表的某些内容,请将它们放在一起。如果需要,阅读和修改更容易。
4)而不是硬编码的值,得到实际的范围。 Range("A2:A2500")
是一个经典的例子。你会一直有数据到2500吗?如果它更少或更多呢?
5)End(xlDown)
永远不会给你的最后一排,如果有一个空白单元格之间。为了让最后一排一列,比方说在“工作表Sheet1”,使用此
Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row`
6)而是循环的,你可以使用WorksheetFunction CountIf()
。尽可能避免循环,因为它们会减慢代码的速度。
7)使用合适的错误处理。
8)注释你的代码。知道特定的代码或部分正在做什么更容易。
CODE
Option Explicit
Sub Run_All_Macros()
Dim ws1I As Worksheet, ws2I As Worksheet, wsO As Worksheet
Dim ws1LRow As Long, ws2LRow As Long, wsOLr As Long
Dim xCell As Range, rFull As Range, rSelection As Range
Dim rCode As Range, rSelectedCode As Range
On Error GoTo Whoa '<~~ Error Handling
Application.ScreenUpdating = False
'~~> Creating the Output Sheet
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Output").Delete
On Error GoTo 0
Sheets.Add.Name = "Output"
Application.DisplayAlerts = True
'~~> Working with 1st Input Sheet
Set ws1I = Sheets("Sheet1")
With ws1I
'~~> Get Last Row of Col A
ws1LRow = .Range("A" & Rows.Count).End(xlUp).Row
'~~> Set the range we want to work with
Set rFull = .Range("A1:A" & ws1LRow)
'~~> The following is not required unless you want to just format the sheet
'~~> This will have no impact on the comparision. If you want you can
'~~> uncomment it
'For Each xCell In .Range("A2:A" & ws1LRow)
'xCell.Value = CDec(xCell.Value)
'Next xCell
End With
'~~> Working with 2nd Input Sheet
Set ws2I = Sheets("Sheet2") '<~~ Input Sheet 2
ws2LRow = ws2I.Range("A" & Rows.Count).End(xlUp).Row
Set rSelection = ws2I.Range("A1:A" & ws2LRow)
'~~> Working with Output Sheet
Set wsO = Sheets("Output")
wsO.Range("A1") = "Common values"
wsOLr = wsO.Range("A" & Rows.Count).End(xlUp).Row + 1
'~~> Comparison : If the numbers match copy them to Output Sheet
For Each rCode In rFull
If Application.WorksheetFunction.CountIf(rSelection, rCode.Value) > 0 Then
rCode.Copy wsO.Range("A" & wsOLr)
wsOLr = wsOLr + 1
End If
Next rCode
MsgBox "Done"
LetsContinue:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
让我知道如果你仍然得到任何错误:)
HTH
优秀,这对我描述的问题完美的作品,谢谢!我只是意识到我没有正确描述最初的问题!我们已经匹配了第一列中的数字,但我也需要复制所选行的其他列中的数据。我将花一些时间阅读你的代码来理解一切,并希望能够解决上述问题。谢谢。 – 2012-04-24 13:53:09
提示:'rCode.Copy wsO.Range(“A”&wsOLr)'你的答案在这里...... – 2012-04-24 13:56:26
我需要定义一个新的范围吗?它看起来像一个简单的命令,但迄今已成功地实现了一些错误,并使用我的第一个值将输出表填充到无穷大:) – 2012-04-24 14:27:16
您已经声明'Selection'作为一个变体。你不应该使用保留字(“选择”)作为变量。快速提问。您试图在哪个表格中运行'Convert_to_Numbers',为什么? – 2012-04-24 12:24:37
Convert_to_Numbers正在'sheet1'上运行,我刚刚意识到,因为我没有指定它正在新的'输出'表上运行,因为它在创建后变为活动状态。刚刚编辑它在正确的工作表上运行时,我得到了一个'400'的错误,这个错误来自于我在原始问题中被星号标出的那一行。 – 2012-04-24 12:43:32
是的。 :)而不是循环使用VBA'Countif()'检查值的存在,然后复制它们。 – 2012-04-24 12:44:35