Есть ли в Excel способ отобразить определенную ячейку, если другая содержит определенный текст? - PullRequest
1 голос
/ 20 апреля 2019

Привет всем, у меня есть документ Excel, который представляет собой список людей и действий, которые эти люди делают, например:

People programmming swimming golf
David       Yes        Yes    No
Lucy        Yes        No     Yes
Martin      No         Yes    Yes

У меня должен быть список действий, подсчитывающий количество людей, которые выполняют эту деятельность, и их имена.Например:

Programming 2 people
     David
     Lucy

Swimming 2 people
     David
     Martin

Я знаю, что справляюсь с функцией IF, но не хочу пробелов между именами, поэтому мне нужна функция, которая: если человек выполняет действие, то имядобавлено, но если нет, то проверяется следующий человек.

Что я могу использовать?

1 Ответ

0 голосов
/ 21 апреля 2019

Вы, кажется, чертовски склонны к подходу VBA, и если это так, скопируйте и вставьте приведенный ниже код в новый модуль в вашей книге ...

Option Explicit

Public Sub TransformData()
    Dim rngCells As Range, lngCol As Long, lngRow As Long, strHeader As String
    Dim lngWriteRow As Long, objDict As Scripting.Dictionary, arrNames() As String
    Dim objDestSheet As Worksheet, i As Long, x As Long

    Set objDestSheet = Worksheets("Transformed")
    Set objDict = New Scripting.Dictionary
    Set rngCells = Selection

    objDestSheet.Cells.Clear

    With rngCells
        For lngCol = 2 To .Columns.Count
            strHeader = .Cells(1, lngCol)

            ' Reset the array in case no names are found to have a yes next to them.
            ReDim Preserve arrNames(0)
            arrNames(0) = ""

            For lngRow = 2 To .Rows.Count
                If Left(UCase(.Cells(lngRow, lngCol)), 1) = "Y" Then
                    ReDim Preserve arrNames(UBound(arrNames) + 1)
                    arrNames(UBound(arrNames)) = .Cells(lngRow, 1)
                End If
            Next

            objDict.Add strHeader, arrNames
        Next
    End With

    With objDestSheet
        For i = 0 To objDict.Count - 1
            strHeader = objDict.Keys(i)
            arrNames = objDict.Items(i)

            strHeader = strHeader & " " & UBound(arrNames) & " people"

            lngWriteRow = lngWriteRow + 1
            .Cells(lngWriteRow, 1) = strHeader

            For x = 1 To UBound(arrNames)
                lngWriteRow = lngWriteRow + 1
                .Cells(lngWriteRow, 1) = arrNames(x)
            Next

            lngWriteRow = lngWriteRow + 1
        Next
    End With

    objDestSheet.Activate
End Sub

... затем создайте листв вашей книге под названием Преобразовано .

Добавьте ссылку на библиотеку ниже ...

enter image description here

Сейчасвыберите вашу матрицу данных и запустите макрос.

enter image description here

Надеюсь, это сработает для вас.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...