将属性中的值分配给Excel中的名称

Question

This is the table to show how the names are written in the fort column.

我需要确定列/属性的值（斜体中的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

以此类推...

我也可以按特定的教师打印而不是每行打印吗？

Answer 1

这将起作用，假设您的数据从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

我运行了一个测试（数据中的数据/范围稍有修改），并且运行正常。