-1

Я знаю, как сортировать строки по их значению, однако, поскольку я продолжаю добавлять новые строки, значения меняются, и я бы хотел, чтобы Excel автоматически сортировал все, что я добавляю. На листе 1 у меня есть такая таблица:

    TEAM 1   TEAM 2   TEAM 3
1    3        3        1
2    1        1        0 
3    0        3        0
4    3        3        0
5    3        1        1

Принимая во внимание, что на листе 2 у меня есть это:

         TOTAL
TEAM 1    10
TEAM 2    11
TEAM 3    2

Sheet2 использует следующую формулу: =SUM(Sheet1!B:Sheet1!B)

Идея состоит в том, что эта таблица должна автоматически сортироваться каждый раз, когда я добавляю новую строку на лист 1. Как мне этого добиться?

1 ответ1

0

Этот макрос не только сортирует, но и делает СУММУ:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim wkb As Workbook
    Set wkb = ThisWorkbook
    Dim wks, wks1 As Worksheet
    Set wks = wkb.Worksheets("Sheet1") ' Sheet with the results
    Set wks1 = wkb.Worksheets("Sheet2") ' Sheet with the totals
    wks1.Rows.Clear ' Clear the contents of Sheet2
    wks1.Cells(1, 2) = "TOTAL"
    usedcolumns = True
    thecolumn = 1
    totalrow = 2
    While usedcolumns
        therow = 1
        totalpoints = 0
        usedrows = True
        While usedrows
            thedata = wks.Cells(therow, thecolumn)
            If thedata <> "" Then
                If therow = 1 Then
                    teamname = thedata
                Else
                    totalpoints = totalpoints + thedata
                End If
                therow = therow + 1
            Else
                usedrows = False
                If therow = 1 Then usedcolumns = False
            End If
        Wend
        If teamname <> "" Then
            wks1.Cells(totalrow, 1) = teamname
            wks1.Cells(totalrow, 2) = totalpoints
            teamname = ""
            totalpoints = 0
            thecolumn = thecolumn + 1
            totalrow = totalrow + 1
        End If
    Wend
    lastrow = wks1.Cells(Rows.Count, 2).End(xlUp).Row
    With wks1
        .Range("A1:B" & lastrow).Sort key1:=.Range("B2:B" & lastrow), order1:=xlDescending, Header:=xlYes
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Перейдите к VBA /Macros с помощью alt+ F11 и дважды щелкните по Sheet1 , затем вставьте этот код с правой стороны.

Чтобы избежать любой потенциальной проблемы, которая может возникнуть, если когда-нибудь макрос вызовет ошибку, заблокировав обнаружение событий в книге, дважды щелкните по This Workbook и вставьте это:

Private Sub Workbook_Open()
   Application.EnableEvents = True
End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .