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

Question

我有一个要从一张纸复制到另一张的数据列表。这是我的数据列表。我的目标是将A列从表2中的第1列移至B列，然后将数据从“ A”“ A”到“ B”到“ C” ...基本上按字母顺序排列。 例如：A列包含（A，A，A，B，CA，B，D，A，B，A），我希望将其排列在第2页的B列中（A，A，A，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的B列中，然后按字母顺序排序它们。

最好的，
C