Присвоить значения из атрибутов именам в Excel - PullRequest
Новая
       10

Присвоить значения из атрибутов именам в Excel

0 голосов
/ 26 августа 2018

В этой таблице показано, как имена записываются в столбце форта.

Мне нужно определить значения столбца / атрибута (5 значений, выделенных курсивом) и назначить егок этому имени.

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

Это код, который я ранее использовал: 

Private Sub loop_through_table()

  Dim cell As Range ' loop through cells, check for names
  Dim col As Range 'loop through Columns, check for XXXXX
  Dim lr As Long ' last active row
  Dim ws As Worksheet: Set ws = Sheets("Sheet4")
  Dim res As String ' will store result
  Dim i As Long 'for loop counter
  Dim maxL As Long ' rightmost last active column


  lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  maxL = ws.Cells(4, Columns.Count).End(xlToLeft).Column

  For i = 5 To lr - 1 ' skip the initials, hence Step 2
    res = "" ' reset of result
    Set cell = ws.Cells(i, 1)
    res = cell + ":"

    For Each col In ws.Range(Cells(i + 1, 2), Cells(i + 1, maxL))
        If col = "XXXXX" Then 'if we found xxxxx
            If Right(res, 1) = ":" Then 'we don't want comma on first argument
                res = res + " " + ws.Cells(3, col.Column)
            Else
                res = res + ", " + ws.Cells(3, col.Column)
            End If
        End If
    Next col

    ws.Cells(i, maxL + 3) = res 'print result to rightmost column + 2

  Next i

End Sub

Таким образом, вывод будет: 

 First Last: Physical, CyberSecurity

 First2 Last2: Mathematical, Artificial Intelligence

и так далее ...

Могу ли я печатать по определенному факультету вместо печати каждой строки?

1 Ответ

0 голосов
/ 27 августа 2018

Это будет работать, предполагая, что ваши данные начинаются с A5 и всегда поддерживают один и тот же формат 

Private Sub loop_through_table()

  Dim cell As Range ' loop through cells, check for names
  Dim col As Range 'loop through Columns, check for XXXXX
  Dim lr As Long ' last active row
  Dim ws As Worksheet: Set ws = Sheets("Your Sheet Name") ' << CHANGE ME!!
  Dim res As String ' will store result
  Dim i As Long 'for loop counter
  Dim maxL As Long ' rightmost last active column


  lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  maxL = ws.Cells(4, Columns.Count).End(xlToLeft).Column

  For i = 5 To lr - 1 Step 2 ' skip the initials, hence Step 2
    res = "" ' reset of result
    Set cell = ws.Cells(i, 1)
    res = cell + " - " + cell.Offset(1, 0) + ":" 'add last name + initialis

    For Each col In ws.Range(Cells(i + 1, 2), Cells(i + 1, maxL))
        If col = "XXXXX" Then 'if we found xxxxx
            If Right(res, 1) = ":" Then 'we don't want comma on first argument
                res = res + " " + ws.Cells(3, col.Column)
            Else
                res = res + ", " + ws.Cells(3, col.Column)
            End If
        End If
    Next col

    ws.Cells(i, maxL + 2) = res 'print result to rightmost column + 2

  Next i

End Sub

Я провел тест (со слегка измененными данными / диапазонами в коде), и он работает, как и ожидалось.

enter image description here

...