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