在Excel VBA中匹配两个数据列表并导出到新工作表 [英] Matching two data lists in Excel VBA and exporting to New Sheet

问题描述

我每月都会收到一个excel文件，并将其部分导出到一个新文件中。我有一个标识符号列表，我试图将所选列表中的数字列表与完整文件相匹配，然后将相关数据的行导出到新工作表。

  Sub Run_All_Macros（）
 Application.ScreenUpdating = False 
 Sheets.Add.Name =Output
调用Convert_to_Numbers 
调用Highlight_Selected_Contractors 
 End Sub 
 
'原始电子表格格式不正确
'将PSD代码转换为数字
 Sub Convert_to_Numbers（）
 Dim xCell As Range 
范围（A2：A2500）。选择
为每个xCell选择
 xCell.Value = CDec（xCell.Value）
下一个xCell 
 End Sub 
 
 
'突出显示所选承包商
 Sub Highlight_Selected_Contractors（）
 Dim Full，Selection，Code，SelectedCode As Range 
 Worksheets（Sheet1）。选择
'将列A中的所有单元格1设置为全
设置完整=工作表（Sheet1）。范围（A1，范围（A1）。结束（xlDown））
'设置所有单元格在列A表2到选择
工作表（Sheet2）。选择
设置选择=工作表（Sheet2）。范围（A1，范围（A1）。结束（xlDown）） 
'如果数字匹配突出显示单元格
对于每个代码满
每个SelectedCode在选择
如果Code.Value = SelectedCode.Value然后
 *** Code.Select 
 Selection.Copy 
 Sheets.Select（Output）
 ActiveSheet.Paste 
 End If 
下一个SelectedCode 
下一个代码
 End Sub 
  

执行此代码列后，输出中的A用A2填充零：A2500 。从错误的断点我已经确定了这个问题是我放在哪里，我不知道那里写的是什么。

谢谢

解决方案

上面的代码中有几个错误，我也有很少的建议，最后是代码。 p>

错误

1） Sheets.Add.Name =Output如果已经有一个名为Ouput​​的工作表，此行将给您一个错误。先删除该表，然后创建它。你一定想知道，如果表不在那里，那我该如何删除呢？对于这种情况，您可以使用 On Error Resume Next ，这在大多数情况下应该避免。

2 ）使用范围时，请始终指定要引用的表格，否则Excel将始终假定您使用的是ActiveSheet。当您意识到 Sub Convert_to_Numbers（）正在考虑输出表格，而您希望操作发生在输出

3） Dim Full，Selection，Code，SelectedCode As Range 如我早先提到的注释，避免使用Excel保留字作为变量。也不像VB.Net，如果你像在VBA中一样声明变量，那么只有最后一个变量将被声明为 Range 。另外3个将被声明为变体。 VB默认变量为Variant类型。 Variant类型变量可以包含字符串，整数，长整型，日期，到货币等任何类型的数据。默认情况下，变体是变量的最慢类型。还应该避免变体，因为它们可能导致可能的类型不匹配错误。这不是我们不应该使用Variants。只有当您不确定代码执行时可以使用它们时，才应该使用它们。

4）避免使用像 .ActiveCell ，选择，选择，激活等等。它们是错误的主要原因。

建议

1） 而不是每次使用Sheets（WhatEver），将其存储在变量中，然后使用该变量。会削减你的代码。

2）缩进你的代码:)更容易阅读

3）组合任务。例如，如果您需要使用某个特定工作表，然后将其保持在一起。如果需要，它更容易阅读和修改。

4）而不是硬编码你的值，获得实际范围。 Range（A2：A2500）是一个典型的例子。你一直有数据到2500？

5） 结束（xlDown）将如果两者之间有空白单元格，则永远不会给你最后一行。要获取列中的最后一行，请在Sheet1中说出A，使用此

 表格（Sheet1）范围（A& Rows.Count）.End（xlUp）.Row` 
  

6）而不是循环，可以使用 WorksheetFunction CountIf（）。应该尽可能避免循环，因为它们会减慢代码的速度。

7）使用适当的错误处理。

8）评论你的代码。了解特定代码或部分的做法要容易得多。

代码

  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'< ~~错误处理
 
 Application.ScreenUpdating = False 
 
'~~>创建输出表
 Application.DisplayAlerts = False 
 On Error Resume Next 
 Sheets（Output）。删除
错误GoTo 0 
 Sheets.Add.Name =Output
 Application.DisplayAlerts = True 
 
'~~>使用第一个输入表
设置ws1I =表（Sheet1）
使用ws1I 
'~~>获取最后一行A 
 ws1LRow = .Range（A& Rows.Count）.End（xlUp）.Row 
'~~>设置我们要使用的范围
设置rFull = .Range（A1：A& ws1LRow）
'~~>以下是不需要的，除非你想要格式化表格
'~~>这对比较没有影响。如果你想要你可以
'~~>对于每个xCell In .Range（A2：A& ws1LRow）
'xCell.Value = CDec（xCell.Value）
'Next xCell 
 End用
 
'~~>使用第二个输入表
设置ws2I =表（Sheet2）'<〜〜输入表2 
 ws2LRow = ws2I.Range（A& Rows.Count）.End（xlUp） .Row 
设置rSelection = ws2I.Range（A1：A& ws2LRow）
 
'~~>使用输出表
设置wsO =表（输出）
 wsO.Range（A1）=常用值
 wsOLr = wsO.Range（A& Rows .Count）.End（xlUp）.Row + 1 
 
'~~>比较：如果数字匹配将它们复制到输出表
对于每个rCode在rFull 
如果Application.WorksheetFunction.CountIf（rSelection，rCode.Value）> 0然后
 rCode.Copy wsO.Range（A& wsOLr）
 wsOLr = wsOLr + 1 
结束If 
下一个rCode 
 
 MsgBox 完成
 
 LetsContinue：
 Application.ScreenUpdating = True 
 Application.DisplayAlerts = True 
 
退出子
哇：
 MsgBox Err.Description 
 Resume LetsContinue 
 End Sub 
  

让我知道如果你仍然会收到任何错误：）

HTH

I receive an excel file monthly and have to export parts of it to a new file. I have a list of identifier numbers and I am trying to match the list of numbers in the selected list to the full file and then export the rows of relevant data to a new sheet.

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

After executing this code column A in 'Output' is filled with zeros from A2:A2500. From messing around with breakpoints I've identified the problem to be where I've placed * but I'm not sure what's wrong with what's written there.

Thanks

解决方案

There few errors in the code above and I also have few suggestions and finally the code.

ERRORS

1) Sheets.Add.Name = "Output" This line will give you an error if there is already a sheet called "Ouput". Delete the sheet first and then create it. You must be wondering that in case the sheet is not there, then how can I delete it? For such scenarios you can use On Error Resume Next which should be avoided in most cases.

2) When working with ranges, always specify which sheet you are referring to else Excel will always assume that you are referring to the "ActiveSheet". As you realized that Sub Convert_to_Numbers() was taking Output Sheet into consideration whereas you want the operation to happen in "Output" Sheet.

3) Dim Full, Selection, Code, SelectedCode As Range As mentioned in my comments earlier avoid using Excel Reserved words as variables. Also unlike VB.Net, if you declare variables as you did in VBA then only the last variable will be declared as Range. The other 3 will be declared as variant. VB defaults the variable to being type Variant. A Variant type variable can hold any kind of data from strings, to integers, to long integers, to dates, to currency etc. By default "Variants" are the "slowest" type of variables. Variants should also be avoided as they are responsible for causing possible "Type Mismatch Errors". It’s not that we should never use Variants. They should only be used if you are unsure what they might hold on code execution.

4) Avoid the use of words like .ActiveCell, Selection, Select, Activate etc. They are a major cause of errors. Also they slow your code down.

SUGGESTIONS

1) Instead to using Sheets("WhatEver") every time, store it in a variable and then use that variable. Will cut down your code.

2) Indent your code :) it's much easier to read

3) Group tasks together. For example if you have to do with something with a particular sheet then keep it together. It is easier to read and amend if required.

4) Instead of hard coding your values, get actual ranges. Range("A2:A2500") is a classic example. Will you always have data till 2500? What if it is less or more?

5) End(xlDown) will never give you the last row if there is a blank cell in between. To get the last row in a column, say A in "Sheet1", use this

Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row`

6) Instead of looping, you can use the WorksheetFunction CountIf(). Loops should be avoided as much as possible as they slow down your code.

7) Use appropriate Error handling.

8) Comment your code. It's much easier to know what a particular code or section is doing.

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

Let me know if you still get any errors :)

HTH

这篇关于在Excel VBA中匹配两个数据列表并导出到新工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！