excel - Excel / VBA - 基于定位的多行到一个 - 如何检查单元格值然后将值保存在另一个单元格中？

Question

我的 excel 表在右侧单元格中有数据值，所以它就像

+---+--------+---------------------+
|   |   A    |          B          |
+---+--------+---------------------+
| 1 | School | newyork high school |
| 2 | Head   | Mr john             |
| 3 | phone  | 0191919             |
| 4 | email  | john@school.com     |
+---+--------+---------------------+

单个单元格中的学校名称，然后其他数据位于单元格旁边。我想垂直排列它们

+---+---------------------+---------+---------+-----------------+
|   |          A          |    B    |    C    |        D        |
+---+---------------------+---------+---------+-----------------+
| 1 | School              | Head    | Phone   | Email           |
| 2 | newyork high school | Mr john | 0191919 | john@school.com |
+---+---------------------+---------+---------+-----------------+

我正在尝试以下列方式获取下一个单元格的值。

Dim cell As Range
For Each cell In Range("a1:a40")
    If cell.Value = school Then
        Range("E3").Value = cell.Offset(1, 0).Value   
Next

Answer 1

尚不清楚您要完成什么，但是，这应该可以帮助您入门：

Sub transposeCellData()
    Dim Rng As Excel.Range
    Dim cll As Excel.Range
    Dim schoolName As String
    Dim schoolHead As String
    Dim schoolAdd As String
    Dim schoolWeb As String
    Dim schoolPhone As String
    Dim schoolFax As String
    Dim outRow As Currency
    outRow = 2
    Set Rng = Range("A1:A40")
    For Each cll In Rng
        If ucase(trim(cll.Value)) = "HEAD:" Then
            schoolName = cll.Offset(-1, 0).Value
            schoolHead = cll.Offset(0, 1).Value
            schoolAdd = cll.Offset(1, 1).Value
            schoolWeb = cll.Offset(2, 1).Value
            schoolPhone = cll.Offset(1, 3).Value
            schoolFax = cll.Offset(2, 3).Value
            Range("I" & outRow).Value = schoolName
            Range("J" & outRow).Value = schoolHead
            Range("K" & outRow).Value = schoolAdd
            Range("L" & outRow).Value = schoolPhone
            Range("M" & outRow).Value = schoolFax
            Range("N" & outRow).Value = schoolWeb
            outRow = outRow + 1
        End If
    Next cll
End Sub

让我知道这是否有帮助。+1