基于公共字段将数据拆分为多个工作簿 [英] Split data on into multiple workbook based on common field
问题描述
嗨！
是否有代码允许根据公共字段将数据拆分为多个工作簿？
For例如，如果我有一个字段，（主表的内容不仅包括新旧类）
| 名称 | 旧类 | 新班级 |
| Apple | 1A | 2C |
| Tommy | 1A | 2C |
| Jim | 1A | 2C |
| Catherine | 1B | 2C |
| 1B | 2C | |
| Melissa | 1B | 2D |
| Lynn | 1B | 2D |
我想分割这些数据，以便2C中的所有学生都在工作簿中，而2D中的所有学生都在工作簿中。有代码可以吗？同时确保每个工作簿上的名称分为3列。
我有一位同事为我做了一次，但他离开了公司，我完全不知道如何使用VBA分割内容，不确定它在这里分享是否有用，但这是他原来的代码：
子重新排序列表（）
Dim lrow，lcol，lrowindex As Long
Dim rng As Range
Dim rank（0 To 10）As String
工作表（"copy"）.Cells.ClearContents
如果不是工作表（"sheet1"）。AutoFilterMode则为
工作表（"sheet1"）。单元格（1,1）.AutoFilter
结束如果
如果ActiveSheet.FilterMode那么ActiveSheet.ShowAllData
lrow =工作表（" sheet1"）。Cells（工作表（" sheet1"）。Rows.Count，1）.End（xlUp）。$ zh $ b lrowindex =工作表（" index& ";"。单元格（工作表（"索引"）。Rows.Count，1）.End（xlUp）.Row - 2
lcol =工作表（" sheet1"）。单元格（1 ，工作表（" sheet1"）。Columns.Count）.End（xlLeftToRight）.Column
设置rng =工作表（" ; sheet1"）。范围（工作表（"sheet1"）。单元格（1,1），工作表（"sheet1"）。单元格（lrow，lcol））
rng.Sort key1：=工作表（"sheet1"）。范围（"B1"），order1：= xlAscending，Header：= xlYes
rng.Sort key1：=工作表（ " sheet1"）。范围（" I1"），order1：= xlAscending，Header：= xlYes
使用工作表（" Index"）
对于r = 0到lrowindex
rank（r）= .Cells（r + 2,1）
下一个r
结束与$
使用工作表（"输出"）
'填写#case
对于r = 0到lrowindex
  .Cells（r + 1,1）.Value = rank（r）
  .Cells（r + 1,2）.Value = Application.WorksheetFunction.CountIf（Worksheets（" sheet1"）。Range（" D2：D& lrow），rank（r））
下一页r
r = 0至lrowindex
如果.Cells（r + 1,2）。值= 0然后
否则
rngstart = .Cells（r + 1,3）。偏移（-1 ，0）+ 2
rngend = .Cells（r + 1,3）+ 1
a = 0
y = Worksheets（" copy"）。Cells（工作表（" copy））。Rows.Count，1）.End（xlUp）.Row + 3
工作表（"复制"）。单元格（y - 1,2）="提升为" &安培;排名（r）
 适用于x = rngstart要结果
 工作表（"复制"）。单元格（y，a + 1）=工作表（"sheet1"）。单元格（x，2）
  a = a + 1
 如果Mod 3 = 0则为
      y = y + 1
      a = a - 3
   
 否则
 结束如果
 下一个x
$
如果ActiveSheet.FilterMode那么ActiveSheet.ShowAllData
结束如果
下一页r
$
MsgBox"已完成"
结束时使用¥b $ b $
结束Sub
使用PowerPivot和Power Query（又名获取和转换）的Excel 2016 Pro Plus
将表拆分为多个表。
没有公式，没有VBA宏。
仅限GUI的PQ。
http://www.mediafire.com/file/wxij79hka3di56i/02_20_17.xlsx
Hi !
Is there a code to allow data to be split into multiple workbooks based on a common field ?
For example if i have a field below, (the content of the main sheet does not only include new and old class)
| Name | Old Class | New Class |
| Apple | 1A | 2C |
| Tommy | 1A | 2C |
| Jim | 1A | 2C |
| Catherine | 1B | 2C |
| Bryan | 1B | 2C |
| Melissa | 1B | 2D |
| Lynn | 1B | 2D |
I would like to split this data such that all all the students in 2C are in a workbook and all the students in 2D are in a workbook . Is there a code to do so ? And at the same time ensuring the names on each workbook are in 3 columns.
I had a colleague who did it for me once but he has left the company and i have totally no idea how to use VBA to split the content, not sure if its useful to share it here but this was the original code that he had:
Sub reorderlist()Dim lrow, lcol, lrowindex As Long
Dim rng As Range
Dim rank(0 To 10) As String
Worksheets("copy").Cells.ClearContents
If Not Worksheets("sheet1").AutoFilterMode Then
Worksheets("sheet1").Cells(1, 1).AutoFilter
End If
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
lrow = Worksheets("sheet1").Cells(Worksheets("sheet1").Rows.Count, 1).End(xlUp).Row
lrowindex = Worksheets("index").Cells(Worksheets("index").Rows.Count, 1).End(xlUp).Row - 2
lcol = Worksheets("sheet1").Cells(1, Worksheets("sheet1").Columns.Count).End(xlLeftToRight).Column
Set rng = Worksheets("sheet1").Range(Worksheets("sheet1").Cells(1, 1), Worksheets("sheet1").Cells(lrow, lcol))
rng.Sort key1:=Worksheets("sheet1").Range("B1"), order1:=xlAscending, Header:=xlYes
rng.Sort key1:=Worksheets("sheet1").Range("I1"), order1:=xlAscending, Header:=xlYes
With Worksheets("Index")
For r = 0 To lrowindex
rank(r) = .Cells(r + 2, 1)
Next r
End With
With Worksheets("output")
'fill in # cases
For r = 0 To lrowindex
.Cells(r + 1, 1).Value = rank(r)
.Cells(r + 1, 2).Value = Application.WorksheetFunction.CountIf(Worksheets("sheet1").Range("D2:D" & lrow), rank(r))
Next r
For r = 0 To lrowindex
If .Cells(r + 1, 2).Value = 0 Then
Else
rngstart = .Cells(r + 1, 3).Offset(-1, 0) + 2
rngend = .Cells(r + 1, 3) + 1
a = 0
y = Worksheets("copy").Cells(Worksheets("copy").Rows.Count, 1).End(xlUp).Row + 3
Worksheets("copy").Cells(y - 1, 2) = "Promoted to " & rank(r)
For x = rngstart To rngend
Worksheets("copy").Cells(y, a + 1) = Worksheets("sheet1").Cells(x, 2)
a = a + 1
If a Mod 3 = 0 Then
y = y + 1
a = a - 3
Else
End If
Next x
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
End If
Next r
MsgBox "done"
End With
End Sub
Excel 2016 Pro Plus with PowerPivot and Power Query (aka Get & Transform)
Split Table into multiple Tables.
No formulas, no VBA macro.
PQ with GUI only.
http://www.mediafire.com/file/wxij79hka3di56i/02_20_17.xlsx
这篇关于基于公共字段将数据拆分为多个工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
