根据列将数据从一个工作表复制到另一个工作表 [英] Copy data from one worksheet to another based on column

问题描述

我正在尝试编写一个宏，该宏将根据列标题将数据从一个工作表复制到另一个工作表.可以说在ws1中有三列:产品"，名称"，雇主"和ws2:产品"，名称"，地区".

I am trying to write a macro that will copy data from one worksheet to another based on column headers. Lets say in ws1 there are three columns: "product", "name", "employer" and the ws2: "product", "name", "region".

所以我希望宏像我的原始文件一样进行所有复制，所以我有100多个列标题，而自己做将非常耗时.

So i want the macro to do all the copying as in my original file i have over 100 column headers and it will be very time consuming for to do it myself.

我写了两个没有成功的宏.VBA是我相当一段时间无法理解的东西.但仍然设法写点东西，希望您能告诉我我是否朝着正确的方向前进.

I have written two macros without succes. VBA is something I cant understand for quite some time. but still managed to write something, hope you can tell me if i am going in the right direction.

这是v1

Sub Copy_rangev1()

Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim SourceRange As Range, CopyRange As Range
Dim lastrow As Long
Dim i As Integer

Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Set Ws2 = ThisWorkbook.Worksheets("sheet2")

lastrow = Cells(Rows.Count, 1).End(xlUp).Row + 1

Set SourceRange = Ws2.Range("A1").CurrentRegion
Set CopyRange = Ws1.Range("A1").CurrentRegion

For i = 1 To lastrow
    If SourceRange.Cells(i, 1).Value = CopyRange.Cells(i, 1) Then
       SourceRange.Cells(i + 1 & lastrow, 1).Copy Destination:=CopyRange.Range("a" & lastrow)
    End If
Next i

End Sub

此v2:

Sub Copyrangev2()

Dim SourceRange As Worksheet
Dim CopyRange As Worksheet
Dim lastrow As Integer
Set SourceRange = Worksheets("Sheet2")
Set CopyRange = ThisWorkbook.Worksheets("sheet1")
Dim i As Integer

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To 100
    If SourceRange.Range(1, i).Value = CopyRange.Range(1, i) Then
       SourceRange.Range(1, i).Offset(1, 0).Copy Destination:=CopyRange.Range(1, i)
    End If
Next i

End Sub

我的代码很乱，但是如果您希望我提供更多详细信息，请不要发表评论，我不希望您提供一个完全可行的代码，一个好的解释和很少的建议会起作用.谢谢

My code is a mess, but if you want me to provide any more details leave a comment, i dont expect you to given a fully workable code, a good explanation and few suggestions will do. Thanks

推荐答案

这个怎么样?该代码的工作方式如下

How about this? This code works as follows

• 遍历 ws1 中的每个列标题，并查看是否匹配标头存在于 ws2
中
• 如果找到匹配项，则将列内容复制到 ws2
中的相关列

• Iterate across each column header in ws1 and see if a matching header exists in ws2
• If a match is found, copy the column contents across to the relevant column in ws2

这将与列顺序无关.您可以更改范围引用以适合.

This will work irrespective of column order. You can change the range references to suit.

Sub CopyHeaders()
    Dim header As Range, headers As Range
    Set headers = Worksheets("ws1").Range("A1:Z1")

    For Each header In headers
        If GetHeaderColumn(header.Value) > 0 Then
            Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("ws2").Cells(2, GetHeaderColumn(header.Value))
        End If
    Next
End Sub

Function GetHeaderColumn(header As String) As Integer
    Dim headers As Range
    Set headers = Worksheets("ws2").Range("A1:Z1")
    GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0)
End Function

这篇关于根据列将数据从一个工作表复制到另一个工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！