使用Excel VBA创build表格并根据特定列中的唯一项目移动数据

我熟悉编程，但不是VBA或Excel对象模型。 我觉得这是非常令人沮丧的处理。

我所拥有的是带有列标题的单个数据表。 根据数据types的不同，标题的数量是可变的，所以我需要find一个并不总是在同一个地方（所以我不能硬编码）的特定列（在所有表中）。

我想为每个姓氏创build一个工作表，最好使用该名称标题，然后从原始工作表复制到每个特定工作表，所有具有名称的ROW

我到目前为止：

Cells.find(What:="Last_Name", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate 

find具有名称的列。 然后，我可以对列进行sorting（这不是完全必要的，但手动执行复制部分时会有所帮助。）

  ActiveCell.Sort key1:=ActiveCell, Order1:=xlAscending, Header:=xlYes 

但之后，我正在努力find一种方法来获取独特的项目列表或数组或东西。

我知道如何创build一个工作表

 Set WS = Sheets.Add WS.name = "string name goes here" 

因此，主要部分是find一种方法来遍历唯一名称，制作工作表并将适当的行复制到工作表中与工作表中名称相同的工作表中。

学习VBA或任何其他方式（.Net以某种方式？）与Excel接口的任何提示将非常赞赏。

Answer 1

这应该让你接近

 Sub MakeLastNameSheets() Dim rLNColumn As Range Dim rCell As Range Dim sh As Worksheet Dim shDest As Worksheet Dim rNext As Range Const sLNHEADER As String = "Last_Name" Set sh = ThisWorkbook.Sheets("Sheet1") Set rLNColumn = sh.UsedRange.Find(sLNHEADER, , xlValues, xlWhole) 'Make sure you found something If Not rLNColumn Is Nothing Then 'Go through each cell in the column For Each rCell In Intersect(rLNColumn.EntireColumn, sh.UsedRange).Cells 'skip the header and empty cells If Not IsEmpty(rCell.Value) And rCell.Address <> rLNColumn.Address Then 'see if a sheet already exists On Error Resume Next Set shDest = sh.Parent.Sheets(rCell.Value) On Error GoTo 0 'if it doesn't exist, make it If shDest Is Nothing Then Set shDest = sh.Parent.Worksheets.Add shDest.Name = rCell.Value End If 'Find the next available row Set rNext = shDest.Cells(shDest.Rows.Count, 1).End(xlUp).Offset(1, 0) 'Copy and paste Intersect(rCell.EntireRow, sh.UsedRange).Copy rNext 'reset the destination sheet Set shDest = Nothing End If Next rCell End If End Sub 

您将以列表中的每个姓氏结尾。 如果你有1000个独特的姓氏，你可能会崩溃excel – 工作表限于可用内存。 它不复制标题行，但这很容易。 它不检查非法的表名字符，所以如果你有任何时髦的姓氏，你可能想清除非alpha。