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 

末次

您可以輕鬆地修改此把結果位於不同的工作，如果你喜歡，它會可以容納儘可能多的列/行數據。