vba - Excel VBA 将变量列范围转置为变量行

Question

StackOverFlow 社区您好，

我不久前开始使用 excel vba，并且确实需要一些帮助来解决一些复杂的问题。

我有一个电子表格，其中有一列“主要”部分及其下方的“替代”部分。我需要创建一个宏，将变量替代部分转置到其关联的 Prime 部分的右侧。因此，对于下面的示例，A 列中的“P”是主要部分，“A”是备用部分:

A |

1P |

1A |

1A |

1A |

2P |

2A |

2A |

3P |

3A |

我尝试创建一个宏，它将给出以下结果:

A || B || C || D |

1P | 1A | 1A | 1A

1A |

1A |

1A |

2P | 2A | 2A

2A |

2A |

3P | 3A

3A |

下面是我能够想出的代码，但所有备用部分都合并到一个范围内，并转置到列表的第一个主要部分。我知道这可能不是我想要实现的目标的最佳方法。我愿意接受所有建议，并期待听到一些很棒的解决方案。

请注意，上面示例中的粗体 Prime 部分实际上在我的电子表格上突出显示，这将解释代码中的“colorindex = 6”

Sub NewHope()

Dim cell As Range
Dim LastRow As Long
Dim Prime As Range
Dim alt As Range


LastRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("A2:A" & LastRow)
    If cell.Interior.ColorIndex = 6 Then
        If Prime Is Nothing Then
            Set Prime = cell
        End If
    Else
        If alt Is Nothing Then
            Set alt = cell
        Else
            Set alt = Union(alt, cell)
        End If

    End If
Next

alt.Copy
Prime.Offset(0, 4).PasteSpecial Transpose:=True

End sub

Answer 1

试试这个代码:

Sub test()
Dim cell As Range
Dim LastRow As Long
Dim PrimeRow As Long
Dim PrimeColumn As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("A2:A" & LastRow)
    If cell.Interior.ColorIndex = 6 Then
        PrimeRow = cell.Row
        PrimeColumn = cell.Column + 1
    Else
        Cells(PrimeRow, PrimeColumn).Value = cell.Value
        PrimeColumn = PrimeColumn + 1
    End If
Next

End Sub