在工作表之间匹配和复制数据

时间:2014-02-12 16:36:17

标签: excel vba excel-vba

我有两个工作表,一个是主要的,另一个是不断变化的。我想比较数据,如果匹配,请将数据复制到主工作表。

我在主工作表中创建了一个userform,其中有一个文本框询问文件名(在本例中为“Change”)。

在我插入文件名“更改”并按下确定后,它应打开该工作表和另一个包含3个文本框(Ref;City;Data)和一个确定按钮的用户窗体。

因此,我可以通过查看Excel文件手动填充用户窗体中的文本框中的正确列: Ref=E;City=G; Data=I.

按OK,应填写“主”工作表,方法是匹配两列的信息,并将我指定的列中的信息复制到“主”工作表,然后关闭“更改”工作表。

修改

我相信我已经改进了一些代码。

要通过文本框打开工作表,然后打开一个新的UserForm:

Private Sub CommandButton1_Click()

    myfile = "C:\Users\ss\Desktop\Reports\" & TextBox1.Value
    Application.Workbooks.Open Filename:=myfile
    Windows.Arrange ArrangeStyle:=xlVertical
    UserForm1.Show

End Sub

匹配工作簿之间的值并复制指定的不同列:

Private Sub CommandButton1_Click()

    Dim Values As Range
    Dim V As Range
    Dim Ref As Range
    Dim City As Range
    Dim Data As Range
    Dim x1, y1, y2, y3, V1, V2, V3, V4

    Application.ScreenUpdating = False
    Workbooks("Main.xlsm").Activate
    Sheets("Sheet1").Select

    Set Values = Range(Range("B4"), Range("B4").End(xlDown))

    For Each V In Values
        x = V.Value

        Workbooks("Change.xlsx").Activate
        Sheets("Sheet1").Select
        V1 = TextBox1.Value
        V2 = TextBox2.Value
        V3 = TextBox3.Value
        V4 = TextBox4.Value

        With Worksheets("sheet1").Columns("C:I")
            On Error Resume Next
            Set Cfind = .Cells.Find(what:=x, lookat:=xlWhole)

            If Cfind Is Nothing Then GoTo line1

            y1 = Cfind.Columns("V2").Value
            y2 = Cfind.Columns("V3").Value
            y3 = Cfind.Columns("V4").Value

            Application.ScreenUpdating = False
            Workbooks("Main.xlsm").Activate
            Sheets("Sheet1").Select
        End With

        V.Offset(0, 1) = y1
        V.Offset(0, 2) = y2
        V.Offset(0, 3) = y3

line1:
    Next V

End Sub

我看不出任何错误,当我运行时,没有错误。

修改 我已经更改了代码来定义我想要的范围,它似乎工作但匹配和复制不是。

Private Sub CommandButton1_Click() 

    myfile = "C:\Users\sst1brg\Desktop\Relatorios\" & TextBox1.Value 
    Application.Workbooks.Open Filename:=myfile 
    Windows.Arrange ArrangeStyle:=xlVertical 

    Dim Values As Range 
    Dim Ref As Range 
    Dim City As Range 
    Dim Data As Range 
    Dim ValuesRng As Range 
    Dim RefRng As Range 
    Dim CityRng As Range 
    Dim DataRng As Range 
    Dim Cfind As Range 
    Dim OriValues As Range 
    Dim V As Range 
    Dim x As String 
    Dim x1, y1, y2, y3 

    Workbooks("Change.xlsx").Activate 
    Sheets("Sheet1").Select 
    Windows("Change.xlsx").Activate 

    Set Values = Application.InputBox( _ 
    prompt:="Select the Values cell", Type:=8) 
    Set ValuesRng = ActiveWorkbook.Sheets("Sheet1").Range(Values, Values.End(xlDown)) 

    Set Ref = Application.InputBox( _ 
    prompt:="Select the Ref cell", Type:=8) 
    Set RefRng = ActiveWorkbook.Sheets("Sheet1").Range(Ref, Ref.End(xlDown)) 

    Set City = Application.InputBox( _ 
    prompt:="Select the City cell", Type:=8) 
    Set CityRng = ActiveWorkbook.Sheets("Sheet1").Range(City, City.End(xlDown)) 

    Set Data = Application.InputBox( _ 
    prompt:="Select the Data cell", Type:=8) 
    Set DataRng = ActiveWorkbook.Sheets("Sheet1").Range(Data, Data.End(xlDown)) 

    Application.ScreenUpdating = False 
    Workbooks("Main.xlsm").Activate 
    Sheets("Sheet1").Select 

    With Worksheets("Sheet1") 
        Set OriValues = Range(Range("B3"), Range("B3").End(xlDown)) 
        For Each V In OriValues 
            x = V.Value 

            Application.ScreenUpdating = False 
            Workbooks("Change.xlsx").Sheets("Sheet1").Activate 

            With Worksheets("Sheet1").Columns("C:I") 
                On Error Resume Next 

                Set Cfind = .Cells.Find(what:=x, Lookat:=xlWhole) 
                If Cfind Is Nothing Then Goto line1 
                y1 = Cfind.Range("RefRng").Value 
                y2 = Cfind.Range("CityRng").Value 
                y3 = Cfind.Range("DataRng").Value 
            End With 

            Application.ScreenUpdating = False 
            Workbooks("Main.xlsm").Activate 
            Sheets("Sheet1").Select 

            Range("C4").Value = y1 
            Range("D4").Value = y2 
            Range("E4").Value = y3 
line1: 
        Next V 
    End With 

End Sub

0 个答案:

没有答案