VBA，通过unqiuestring对工作表中的数据进行sorting

我当前的macros从工作簿A或工作表A中逐行取得我的数据，并根据匹配的标题将其分成不同的工作表。 我无法进一步将这些表单中的string字段拆分。

例如，工作簿A的B列中的数据包含10个唯一string，如何将stringx仅sorting为一个工作表，然后将剩余的string串联到其他工作表。 因此，包含表单x的行将转到某个表单，并且stringabc将正常工作。

这是我的代码到目前为止，特别是调出工作簿和工作表名称，所以它不是dynamic的：

Option Explicit Sub main() Dim dsRng As Range Dim sht As Worksheet Dim AShtColsList As String, BShtColsList As String Set dsRng = Workbooks("Workbook A").Worksheets("Sample Extract").Range("A1").CurrentRegion '<--| set your entire data set range in workbook "A" worksheet "ShtA" (change "A" and "ShtA" to your actual names) dsRng.Sort key1:=dsRng.Range("A1"), order1:=xlAscending, Header:=xlYes '<--| sort data set range on its 1st column (which is "A", beginning it from column "A") With Workbooks("Workbook B") '<--| refer "B" workbook For Each sht In .Worksheets(Array("Stack", "Documentation", "Users")) '<--| loop through its worksheets GetCorrespondingColumns dsRng, sht, AShtColsList, BShtColsList '<--| build lists of corresponding columns indexes in both workbooks CopyColumns dsRng, sht, AShtColsList, BShtColsList '<--| copy listed columns between workbooks Next sht End With End Sub Sub GetCorrespondingColumns(dsRng As Range, sht As Worksheet, AShtColsList As String, BShtColsList As String) Dim f As Range, c As Range Dim iElem As Long AShtColsList = "" '<--| initialize workbook "A" columns indexes list BShtColsList = "" '<--| initialize workbook "B" current sheet columns indexes list For Each c In sht.Rows(2).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through workbook "B" current sheet headers in row 2 ******* Set f = dsRng.Rows(1).Find(what:=c.Value, lookat:=xlWhole, LookIn:=xlValues) '<--| look up data set headers row for workbook "B" current sheet current column header If Not f Is Nothing Then '<--| if it's been found ... BShtColsList = BShtColsList & c.Column & "," '<--| ...update workbook "B" current sheet columns list with current header column index AShtColsList = AShtColsList & f.Column & "," '<--| ...update workbook "A" columns list with corresponding found header column index End If Next c End Sub Sub CopyColumns(dsRng As Range, sht As Worksheet, AShtColsList As String, BShtColsList As String) Dim iElem As Long Dim AShtColsArr As Variant, BShtColsArr As Variant If AShtColsList <> "" Then '<--| if any workbook "B" current sheet header has been found in workbook "A" data set headers BShtColsArr = Split(Left(BShtColsList, Len(BShtColsList) - 1), ",") '<--| build an array out of workbook "B" current sheet columns indexes list AShtColsArr = Split(Left(AShtColsList, Len(AShtColsList) - 1), ",") '<--| build an array out of workbook "A" corresponding columns indexes list For iElem = 0 To UBound(AShtColsArr) '<--| loop through workbook "A" columns indexes array (you could have used workbook "A" corresponding columns indexes list as well) Intersect(dsRng, dsRng.Columns(CLng(AShtColsArr(iElem)))).Copy sht.Cells(2, CLng(BShtColsArr(iElem))) '<--| copy data set current column into workbook "B" current sheet corresponding column starting from row 2 ******* Next iElem End If End Sub 

谢谢。

编辑

完整的提取。 在工作簿B中调用此示例提取。

'用户'表。 我的macros已经这样做了。

“文档”表，我的macros也已经这样做了

'堆栈'表。 我的macros不这样做。 它过滤loggingstackoverflow及其相关的列。

希望这有助于。

Answer 1

将数据保存在名为“data”的表中。 下面的代码将为B列中的每个唯一值生成单独的表格，并显示相应值的数据。

 Dim data, sht As Worksheet Dim rng As Range Dim counter As Long Set data = ThisWorkbook.Sheets("data") data.Activate Range("B:B").Copy Range("H:H").PasteSpecial xlPasteValues Range("H:H").RemoveDuplicates Columns:=1, Header:=xlYes Set rng = data.Range("H2") Do While rng.Value <> "" Set sht = ThisWorkbook.Worksheets.Add sht.Name = rng.Value data.Activate ActiveSheet.AutoFilterMode = False Range("A1").AutoFilter field:=2, Criteria1:=rng.Value Range("A1:C1").Select Range(Selection, Selection.End(xlDown)).Select Selection.SpecialCells(xlVisible).Copy sht.Activate Range("A1").PasteSpecial xlPasteValues Range("A1").Activate Set rng = rng.Offset(1, 0) Loop 

它将在相同的工作簿中创build工作表。