Excel，高级数据合并

Question

我需要合并几个非常大的数据集。这些数据集来自不同的研究，所以格式等是不同的。

我想要的是一个可以搜索列值的宏（例如Name = George），然后将其中出现的每个值复制并粘贴到不同工作表上的新列中。

例子：

Answer 1

下面是完整的代码：

Option Explicit 

Sub myMacro() 

    ' decleration 
    Dim rowMain As Integer, rowNewSheet As Integer 
     rowMain = 2 
     rowNewSheet = 1 

    Dim columnOffset As Integer 
     columnOffset = 0 

    ' main sheet where data is 
    Sheets("Sheet1").Select 

    ' loop through all names 
    Do While Range("A" & rowMain).Value <> "" 

     Do While Range("B" & rowMain - 1).Offset(0, columnOffset).Value <> "" 

      ' Name 
      Application.Sheets("Sheet2").Range("A" & rowNewSheet).Value = Range("A" & rowMain).Value 

      ' Year 
      Application.Sheets("Sheet2").Range("B" & rowNewSheet).Value = Range("B1").Offset(0, columnOffset).Value 

      ' Color 
      Application.Sheets("Sheet2").Range("C" & rowNewSheet).Value = Range("B" & rowMain).Offset(0, columnOffset).Value 

      ' next line 
      rowNewSheet = rowNewSheet + 1 
      columnOffset = columnOffset + 1 

     Loop 

     ' next Name 
     columnOffset = 0 
     rowMain = rowMain + 1 

    Loop 

End Sub 

这应该做你要找的工作。让我知道是否有问题。

Answer 2

根据您提供，忽略了大标题的例子中，宏将是这个样子：

Option Explicit 

Sub myMacro() 

    Dim row As Integer 
     row = 1 

    Application.Sheets("Sheet2").Range("A" & row).Value = Range("A" & row + 1).Value 
    Application.Sheets("Sheet2").Range("B" & row).Value = Range("B" & row).Value 
    Application.Sheets("Sheet2").Range("C" & row).Value = Range("B" & row + 1).Value 

End Sub 

的代码会改变基于怎样的数据是有组织的。但上面的代码显示了如何完成的基本想法。许多方法之一。

Answer 3

你可以试试这个不是很整齐的解决方案。
此外，为此，您需要将源数据更改为表格。

Sub Test() 
    Dim ws As Worksheet: Set ws = Sheet1 
    Dim id, ids, yr, yrs 
    Dim rng As Range 

    With Application 
     Set rng = ws.ListObjects("Table1").HeaderRowRange 
     Set rng = rng.Offset(0, 1).Resize(, rng.Columns.Count - 1) 
     yrs = .Transpose(rng) 
     ids = .Transpose(ws.Range("Table1[Name]")) 
    End With 

    Dim lrow As Long 
    For Each id In ids 
     Dim r As Range: Set r = ws.Range("Table1[Name]").Find(id) 
     Dim i As Long: i = 1 
     For Each yr In yrs 
      With ws 
       lrow = .Range("A:A").Find("*", [A1], , , , xlPrevious).Row 
       .Range("A" & lrow).Offset(1, 0).Value = id 
       .Range("A" & lrow).Offset(1, 1).Value = yr 
       .Range("A" & lrow).Offset(1, 2).Value = r.Offset(0, i).Value 
      End With 
      i = i + 1 
     Next 
    Next 
End Sub 

结果：

我做的源数据改变成表所以我可以采取的ListObject的优点。
在该示例中，表名是表1。如果您想采取此路线，您可以更改以适应。
不管怎样，HTH虽然大部分都会模糊不清，因为你指出你在编码方面的经验很少。

Answer 4

下面是使用类创建用户定义类型的另一种方法，以收集每个名称/年/颜色组合，然后输出结果。它可以与任何数量的“年”，名称或颜色一起使用。

这第一个代码进入一个类模块，你应该重新命名NameData（见芯片Pearsons网页类）

================== ===========

Option Explicit 
Private pName As String 
Private PYear As Long 
Private pColor As String 

Public Property Get Name() As String 
    Name = pName 
End Property 
Public Property Let Name(Value As String) 
    pName = Value 
End Property 

Public Property Get Color() As String 
    Color = pColor 
End Property 
Public Property Let Color(Value As String) 
    pColor = Value 
End Property 

Public Property Get Year() As Long 
    Year = PYear 
End Property 
Public Property Let Year(Value As Long) 
    PYear = Value 
End Property 

================================ ==

这第二代码进入一个常规模块：

================ ================

Option Explicit 
Sub ReArrange() 
    Dim cND As NameData 
    Dim colND As Collection 
    Dim vSrc As Variant 
    Dim vRes() As Variant 
    Dim rRes As Range 
    Dim I As Long, J As Long 

'Results will go here 
Set rRes = Range("a20") 'could be on another worksheet 

'Read source data into array 
'Many ways to select the data, depending on your "real" setup 
vSrc = Range("a2").CurrentRegion 

'Collect each Name/Year/Color combo 
Set colND = New Collection 
For I = 2 To UBound(vSrc, 1) 
    For J = 2 To UBound(vSrc, 2) 
    Set cND = New NameData 
    With cND 
     .Name = vSrc(I, 1) 'Name always in first column 
     .Year = vSrc(1, J) 'Year always in first row 
     .Color = vSrc(I, J) 'Color at intersection 

     'add to collection 
     colND.Add cND 
    End With 
    Next J 
Next I 

'Dimension and populate output array 
ReDim vRes(0 To colND.Count, 1 To UBound(vSrc, 2) - 1) 

'Column Labels 
vRes(0, 1) = "Name" 
vRes(0, 2) = "Year" 
vRes(0, 3) = "Color" 

J = 0 
For I = 1 To colND.Count 
    J = J + 1 
    With colND(I) 
     vRes(J, 1) = .Name 
     vRes(J, 2) = .Year 
     vRes(J, 3) = .Color 
    End With 
Next I 

With rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2)) 
    .Resize(Cells.Rows.Count - .Row).Clear 
    .Value = vRes 
End With 

末次

您可以轻松地修改此把结果位于不同的工作，如果你喜欢，它会可以容纳尽可能多的列/行数据。