工作表中的列粘贴和排序数据

Question

我有一个要从一张纸复制到另一张纸的数据列表。 这是我的数据列表。 我的目标是将 A 列从表 1 移动到表 2 中的 B 列，并将数据从“a”到“b”再到“c”……基本上按字母顺序排列。 例如：A列包含（a，a，a，b，ca，b，d，a，b，a），我希望它像这样排列在第2页的B列中（a，a，a，a , a, a, b, b, b, c, d)。 下面是我的代码。 如果可以的话请帮忙。

Sub Button1_Click()

    lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 2 To lastrow
    
'Conditional if statement that copies "a's" in Sheet 1, Column A and pastes in Sheet 2, Column B
        If Worksheets("Sheet1").Range("A" & i).Value = "a" Then
            Worksheets("Sheet1").Range("A" & i).Copy
            
            Worksheets("Sheet2").Activate
            lastRow2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
            
            Worksheets("Sheet2").Range("B" & i + 1).Select
            
                        
            ActiveSheet.Paste
            'Worksheets("Sheet2").Range("B" & i + 1).Interior.Color = vbCyan
            'Worksheets("Sheet2").Range("B" & i).Borders.Color = rbgBlack
        End If
    
        'Deletes empty cells and shifts "a's" upward
        If Worksheets("Sheet2").Range("B" & i).Value = "" Then
                        Columns("B:B").Select
                        Selection.SpecialCells(xlCellTypeBlanks).Select
                        Selection.Delete Shift:=xlUp
        End If
              
'Conditional if statement that copies data in Sheet 1, Column B and pastes in Sheet 2, Column C
        If Worksheets("Sheet1").Range("A" & i).Value = "a" Then
            Worksheets("Sheet1").Range("B" & i).Copy
            
            Worksheets("Sheet2").Activate
            lastRow2 = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
            
            Worksheets("Sheet2").Range("C" & i + 1).Select
                        
            ActiveSheet.Paste
        End If
        
        'Deletes empty cells and shifts data upward in Column C
        If Worksheets("Sheet2").Range("A" & i).Value = "" Then
                        Columns("C:C").Select
                        Selection.SpecialCells(xlCellTypeBlanks).Select
                        Selection.Delete Shift:=xlUp
        End If
        
    Next i
          
End Sub

Answer 1

我相信你把自己弄得太复杂了。 这应该有效：

    lastrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Range("A2:A" & lastrow).Select
    Selection.Cut
    Sheets("Sheet2").Select
    Range("B2").Select
    ActiveSheet.Paste
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add2 Key:=Range("B2:B" & lastrow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("B2:B" & lastrow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

它需要 Sheet1 的 ColumnA，剪切其内容并将它们粘贴到 Sheet2 的 ColumnB 中，然后按字母顺序对它们进行排序。

最好的，C.