Excel，高级数据整合

Question

我需要整合几个非常大的数据集。这些数据集来自不同的研究，因此格式化等是完全不同的。

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

示例：

Answer 1

根据您提供的示例，忽略大标题，宏将看起来像这样：

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 2

以下是完整代码：

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 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 。
在示例中，表名为 Table1 。如果你想采取这条路线，你可以改为适合 无论如何，HTH虽然大部分都会模糊，因为你指出你的编码经验很少。

Answer 4

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

第一个代码进入一个类模块，你应该重命名 NameData （参见关于类的Chip 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

End Sub

如果愿意，您可以轻松修改此结果以将结果放在不同的工作表上，并且它可以容纳尽可能多的列/行数据。