如何根据A列中的单词将一个Excel表格的行导出到新的Excel表格中
我有一个超过8000行的工作表，每个29个单词中的1个作为列A中的标识符。我想编写一个VBA脚本，将parsing所有的行，将它们按列A中的标识符分组，并导出每个分组到一个新的工作表，并命名每个工作表作为其标识符
例如，如果这是我的数据：
Column A Column B Column C X cat blue Y dog red Z bird green Y whale yellow Z tiger black X wolf purple 我希望这个输出名为X的Sheet 1：
Column A Column B Column C X cat blue X wolf purple
我希望这个输出名为Y的Sheet 2：
Column A Column B Column C Y dog red Y whale yellow
而这个名为Z的Sheet 3的输出：
Column A Column B Column C Z bird green Z tiger black
你可以使用Range对象的AutoFilter()方法，如下所示：
选项显式
Sub main() Dim helperCol As Range, cell As Range With Worksheets("Data") '<--| reference your relevant sheet (change "Data" to your actual sheet name) Set helperCol = .UsedRange.Resize(, 1).Offset(, .UsedRange.Columns.COUNT) '<--| set a "helper" range where to store unique identifiers With .Range("C1", .Cells(.Rows.COUNT, 1).End(xlUp).Offset(1)) '<-- reference its "data" range from cell "A1" to last not empty cell in column "C" helperCol.Value = .Resize(, 1).Value '<--| copy identifiers to "helper" range helperCol.RemoveDuplicates Columns:=1, Header:=xlYes '<--| remove duplicates in copied identifiers For Each cell In helperCol.Resize(helperCol.Rows.COUNT - 1).Offset(1).SpecialCells(xlCellTypeConstants) '<--| loop through unique identifiers, skipping header .AutoFilter Field:=1, Criteria1:=cell.Value '<--| filter "data" on identifiers column with current (unique) identifier .SpecialCells(xlCellTypeVisible).Copy Destination:=GetOrCreateSheet(cell.Value).Range("A1") '<--| copy filtered data (skipping header) and paste it to corresponding sheet starting from its column "A" first not emtpy cell Next cell End With .AutoFilterMode = False '<--| show all rows back helperCol.ClearContents '<--| clear "helper" range End With End Sub Function GetOrCreateSheet(shtName As String) As Worksheet On Error Resume Next Set GetOrCreateSheet = Worksheets(shtName) If GetOrCreateSheet Is Nothing Then Set GetOrCreateSheet = Worksheets.Add GetOrCreateSheet.name = shtName Else GetOrCreateSheet.Cells.ClearContents End If End Function
你在这里有一个多步骤的问题。 你写了任何代码到目前为止？ 如果您遇到任何特定的错误，请将其发布到此处，我们很乐意提供更具体的build议。
现在，我会build议把你的问题分解成它的组件特征。 然后，您可以继续工作，寻求帮助，并完成这些部分的每一个部分，并将其结合在一起。
推荐的一步一步的方法：
步骤1：循环遍历一个范围。
一些例子。
第2步：parsing并保存结果。
了解VBA条件语句的起始位置。
了解VBAarrays的起点。
第3步：添加并命名一个新的工作表。
先前的堆栈溢出答案。
第4步：将您存储的信息放在新的表格上。
如果你正在使用数组的方法，这里有一个关于移调function的先前的堆栈溢出问题。
祝你好运！
如果您使用Excel for Windows，则可以通过ADO ODBC访问Jet / ACE SQL Engine并运行SQL查询来实现需求。 是的，你可以查询当前的工作簿（最后保存的实例）：
Sub RunSQL() Dim conn As Object, rst As Object Dim strConnection As String, strSQL As String Dim i As Integer, fld As Object Dim WS As Worksheet, var As Variant Set conn = CreateObject("ADODB.Connection") Set rst = CreateObject("ADODB.Recordset") ' STRING CONNECTION (TWO VERSIONS) ' strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ ' & "DBQ=C:\Path\To\Workbook.xlsm;" strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _ & "Data Source='C:\Path\To\Workbook.xlsm';" _ & "Extended Properties=""Excel 8.0;HDR=YES;"";" ' OPEN DB CONNECTION conn.Open strConnection For Each var In Array("X", "Y", "Z") ' CREATE WORKSHEET Set WS = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)) WS.Name = var ' SQL STATEMENT strSQL = " SELECT [Sheet1$].[Column A], [Sheet1$].[Column B]," _ & " [Sheet1$].[Column C]" _ & " FROM [Sheet1$]" _ & " WHERE [Sheet1$].[Column A] = '" & var & "';" ' OPEN RECORDSET rst.Open strSQL, conn ' COLUMN HEADERS WS.Range("A1").Activate For i = 1 To rst.Fields.Count WS.Cells(1, i) = rst.Fields(i - 1).Name Next i ' DATA ROWS WS.Range("A2").CopyFromRecordset rst rst.Close Next var conn.Close Set rst = Nothing: Set conn = Nothing End Sub