将空白分隔的数据的动态范围移动到单独选项卡中的新列

Question

我对 VBA 的经验几乎为 0。我到处寻找，希望有人能帮忙。我有一个由 ixchariot 脚本创建的.csv。我正在尝试将 P 列中的数据第一次分成几组，这是.csv每个输出的动态范围（例如，第一次运行将和 colump P 组将是 P1-P68，第 2 组将是 P1-P100），然后将每个组移动到单独的选项卡中自己的列中（例如，组 1 列 A， 第 2 组 B 列）。为了分组分开，我使用组号 1 到 x 的 B 列）脚本看起来像这样......

Sub InsertRowsAtValueChange()
'Update 20140716
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address,      Type:=8)
Application.ScreenUpdating = False
For i = WorkRng.Rows.Count To 2 Step -1
If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
    WorkRng.Cells(i, 1).EntireRow.Insert
End If
Next
Application.ScreenUpdating = True
End Sub

所以我有组的分离，但是如何将组的动态范围从p列移动到新选项卡，然后再移动到单独的列中？

分成几组

在单独的选项卡中所需的输出

感谢您的任何帮助！

Answer 1

首先，让我们移动 P 列

Sheets("PrimarySheet").Range("P:P").Copy
Sheets("AnotherSheet").Range("A:A").PasteSpecial xlPasteValues

我对此有点蹩脚，但是删除每个重复条目的行

Dim LR as Long
LR = Cells(Sheets("AnotherSheet").Rows.Count, 1).End(xlUp).Row
Dim i as Integer
For i = 1 to LR
    If Cells(i,1)=Cells(i+1,1) Then
        Sheets("AnotherSheet").Rows(i+1).Delete
        Else:
        End If
Next i

现在，您需要返回主工作表并根据 P 列对总范围进行排序，在另一张工作表上循环浏览该列表（这是我需要开始查找更多内容的部分，所以它不会是完整的代码......我将编辑）

Dim j as Integer
Dim LR1 as Long
LR1 = Cells(Sheets("PrimarySheet").Rows.Count, 1).End(xlUp).Row
Dim LR1 as Long
For j = 1 to LR1
With Sheets("PrimarySheet")
    .AutoFilterMode = False
    .Columns(16).AutoFilter Field:=1, Criteria1:=    Sheets("AnotherSheet").Cells(j,1).Value
End With
Redim LR1 as Long
Sheets("PrimarySheet").Range(Cells(1,1),Cells(LR1)).Copy
ActiveWorkbook.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = Sheets("AnotherSheet").Cells(j,1).Value
Sheets(Cells(j,1).Value).Range("A1").PasteSpecial xlPasteValues
Next j

希望这对您来说是一个不错的开始，如果不足以完成您的工作！