Question

我正在研究vba代码，并希望执行以下操作：

读：

  A      B
1 John   100
2 Jill   90 
3 John   95
4 Amy    82

更改为（按字母顺序）：

  A    B   C
1 Amy  82
2 Jill 90
3 John 100 95

最终我需要它来显示学生的名字和名字旁边的所有分数。

到目前为止我有这个：

Sub Combine()

Dim J As Integer
Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim wrk1 As Worksheet
Dim r1, r2, r3, r4, r5, r6, r7, ra, rb, rc, rd, re, rf, rg As Range
Sheets("Sheet2").Select
Set r1 = Range("D:D")
Set r2 = Range("B:B")
Set r3 = Range("E:E")
Set r4 = Range("C:C")
Set r5 = Range("F:F")
Set r6 = Range("H:H")
Set r7 = Range("AX:AX")
Sheets("Sheet3").Select
Set ra = Range("D:D")
Set rb = Range("B:B")
Set rc = Range("E:E")
Set rd = Range("C:C")
Set re = Range("F:F")
Set rf = Range("H:H")
Set rg = Range("AX:AX")

Set wrk = Workbooks.Add

ActiveWorkbook.Sheets(2).Activate

 r1.Copy Range("A1")
 r2.Copy Range("B1")
 r3.Copy Range("C1")
 r4.Copy Range("D1")
 r5.Copy Range("E1")
 r6.Copy Range("F1")
 r7.Copy Range("G1")

 ActiveWorkbook.Sheets(3).Activate

 ra.Copy Range("A1")
 rb.Copy Range("B1")
 rc.Copy Range("C1")
 rd.Copy Range("D1")
 re.Copy Range("E1")
 rf.Copy Range("F1")
 rg.Copy Range("G1")

On Error Resume Next
Sheets(1).Select
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A2").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A3").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)

Sheets(1).Select

Range("A1:AY100").Sort _
Key1:=Range("C1"), Key2:=Range("B1"), Header:=xlYes



Next



End Sub

Answer 1

我会为您的案例创建一个数据透视表。它易于创建，易于更新且易于维护。但是，这里有一段代码：

Sub pivotDataInColumns()
    Dim sourceSheet As Excel.Worksheet
    Dim destinationSheet As Excel.Worksheet
    Dim sourceRow As Long
    Dim destinationRow As Long
    Dim matchRow As Long
    Dim searchColumn As Excel.Range
    Dim nameToFind As String
    Dim lastColumn As Long

    Application.ScreenUpdating = False

    With ThisWorkbook
        'Change Worksheet name to suit:
        Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
        Set destinationSheet = ThisWorkbook.Worksheets.Add
    End With
    Set searchColumn = destinationSheet.Columns("A")

    For sourceRow = 1 To getLastRow(sourceSheet.Columns("A"))
        nameToFind = sourceSheet.Cells(sourceRow, "A").Value

        destinationRow = getMatchRow(nameToFind, searchColumn)
        If destinationRow = 0 Then
            destinationRow = getLastRow(destinationSheet.Columns("A")) + 1
            destinationSheet.Cells(destinationRow, "A").Value = sourceSheet.Cells(sourceRow, "A").Value
        End If

        lastColumn = getLastColumn(destinationSheet.Rows(destinationRow)) + 1
        destinationSheet.Cells(destinationRow, lastColumn).Value2 = sourceSheet.Cells(sourceRow, "B").Value2
    Next sourceRow

    'Remove row 1 garbage and sort:
    With destinationSheet
        .Rows(1).Delete
        .UsedRange.Sort Key1:=.Range("A1"), _
                        Order1:=xlAscending, _
                        Header:=xlNo
    End With

    Application.ScreenUpdating = True

    MsgBox "Data processed successfully.", vbInformation
End Sub

Private Function getMatchRow(searchValue As Variant, _
                             searchArray As Variant) As Long
  'This function returns 0 if searchValue is not on searchArray.

  Dim element As Long

  On Error Resume Next
  element = WorksheetFunction.Match(CDbl(searchValue), searchArray, 0)
  If element = 0 Then element = WorksheetFunction.Match(CStr(searchValue), searchArray, 0)

  getMatchRow = element
End Function

Private Function getLastRow(sourceRange As Excel.Range) As Long
    Dim parentSheet As Excel.Worksheet
    Dim lastRow As Long

    Set parentSheet = sourceRange.Parent
    With parentSheet
        lastRow = .Cells(.Rows.Count, sourceRange.column).End(xlUp).row
    End With

    getLastRow = lastRow
End Function

Private Function getLastColumn(sourceRange As Excel.Range) As Long
    Dim parentSheet As Excel.Worksheet
    Dim lastColumn As Long

    Set parentSheet = sourceRange.Parent
    With parentSheet
        lastColumn = .Cells(sourceRange.row, .Columns.Count).End(xlToLeft).column
    End With

    getLastColumn = lastColumn
End Function

列出测试分数

1 个答案: