使用公式不变的VBA转换数据

代码：

我需要用它们的公式转换的范围。

sourceRowRange

是用户所做的选择，例如：image

RangeFilled WithTransposedData

是用户选择用于转换所选范围的单元格。用户希望能够灵活地选择用于转置的范围，并且能够灵活地将数据转置到当前工作表中的任何位置

如您所见，

D3

是公式，即

=B3*C3

。同样，公式适用于

列D

中的剩余单元格

现在，在使用上述代码时，我面临两个问题：
1.我必须选择输出单元格，正如您在代码中看到的那样。但是，当我这样做时，只有第一个值被粘贴到该输出单元格中，即该值从

B3

打印为“1”。但是，当我为输出单元格选择一个范围时，例如，与我选择的单元格数相同的单元格数，那么我将得到所有转置的列。这意味着如果我选择2个单元格，那么只有2个单元格将被转置，如果我选择10个单元格，那么10个单元格将被转置。在我提供与我的选择相同数量的单元格之前，它不会从选择中转置所有单元格。

2.这些公式不会被转换。只有

列D

中的值被转置。有没有办法用各自的公式转换数据？

这应该可以：

Sub transposeTest()
   Dim transposedVariant As Variant
   Dim sourceRowRange As Range
   Dim sourceRowRangeVariant As Variant

   Set sourceRowRange = Selection
   sourceRowRangeVariant = sourceRowRange.Value
   transposedVariant = Application.Transpose(sourceRowRangeVariant)

   Dim rangeFilledWithTransposedData As Range
   Set rangeFilledWithTransposedData = Application.InputBox("Select cell to transpose selected data :", "Transpose Data", , , , , , 8) ' eight rows, one column
   rangeFilledWithTransposedData.Value = transposedVariant
End Sub

请记住，如果公式使用相对单元格引用，则可能会得到意外的结果

代码说明：

Sub test()
Application.ScreenUpdating = False

Dim ws As Worksheet: Set ws = Worksheets("Sheet1") 'Type the sheet where the data is pasted
Dim myRows As Long
Dim myColumns As Long
Dim rng As Range
Dim userInput As String
Dim Outputrng As Range
Dim rowCounter As Long
Dim columnCounter As Long

myColumns = Selection.Columns.Count

userInput = InputBox("Type output cell eg. B10")
If userInput = vbNullString Then Exit Sub

rowCounter = 0
columnCounter = -1

For Each rng In Selection

    columnCounter = columnCounter + 1

    If columnCounter > myColumns - 1 Then columnCounter = -1

    If columnCounter = -1 Then
        rowCounter = rowCounter + 1
        columnCounter = 0
    End If

    Set Outputrng = ws.Range(userInput).Offset(columnCounter, rowCounter)

        If rng.HasFormula = True Then
           rng.Formula = Application.ConvertFormula(rng.Formula, xlA1, xlA1, 1)
        End If

    rng.Copy
    Outputrng.PasteSpecial xlPasteFormulas

Next

Application.ScreenUpdating = True
End Sub

上面的代码段存储选定区域中的列数，以供将来使用

myColumns = Selection.Columns.Count

上面的代码片段提示一个

输入框

，用户可以在其中写入所需的输出单元格。输出单元格将是转置数据的左上角单元格。 如果用户未键入值，

If

语句将退出

sub

选择中每个rng的

循环通过所选范围内的每个单元格。代码首先从左到右遍历列，然后向下遍历一行并再次遍历列。该循环的总体思路是识别单元的位置，然后将其粘贴到相应的转置位置

列计数器
和
行计数器
跟踪单元格的位置
columnCounter=0
和
rowCounter=0
将是第一个被转置的单元格。此单元格将粘贴到用户指定的输出单元格
columnCounter=1
和
rowCounter=0
将是要转置的第二个单元格。此单元格粘贴在同一列中，但在输出单元格下一行

在每个循环开始时，
columnCounter
的值增加
1
，这可以在
columnCounter=columnCounter+1
行上看到

当
columnCounter
的值大于
myColumns
的值时，
columnCounter
的值设置为
-1
。当
列计数器
的值为
-1
时，
行计数器
的值增加
1
，并且
列计数器
的值重置为
0
。这意味着循环已经完成了一行中的列，现在正在移动到下一行。

所有这些都可以在以下代码段中看到：

userInput = InputBox("Type output cell eg. B10")
If userInput = vbNullString Then Exit Sub

既然已经确定了单元格的位置，我们需要将其粘贴到正确的“
输出范围
”，该范围在代码中称为
Outputrng
。这是在以下行中完成的：

If columnCounter > myColumns - 1 Then columnCounter = -1

If columnCounter = -1 Then
   rowCounter = rowCounter + 1
   columnCounter = 0
End If

此行的基础是
范围（用户输入）
。这是用户通过
输入框
指定的原始输出单元格。使用
.Offset
我们可以使用相对于用户指定的输出单元格的单元格。由于需要转置原始选择，我们使用
列计数器
和
行计数器
反转原始单元格的位置

请注意，
列计数器
用作
行偏移量
，而
行计数器
用作
列偏移量

接下来，我们检查单元格是否包含公式。如果是，则公式将转换为绝对参考。这是通过以下代码行完成的：

Set Outputrng = ws.Range(userInput).Offset(columnCounter, rowCounter)

If rng.HasFormula = True Then
   rng.Formula = Application.ConvertFormula(rng.Formula, xlA1, xlA1, 1)
End If

请注意，末尾的
1
指定我们需要绝对引用。如果需要相对引用，只需将
1
更改为
4

最后一步是将原始单元格粘贴到
outputng
。为了确保我们也粘贴了公式，我们使用了
.PasteSpecial xlPasteFormulas
。如果单元格不包含公式，则粘贴该值。这是在以下代码行上完成的：

Set Outputrng = ws.Range(userInput).Offset(columnCounter, rowCounter)

If rng.HasFormula = True Then
   rng.Formula = Application.ConvertFormula(rng.Formula, xlA1, xlA1, 1)
End If

使用
Next
告诉代码转到选择中的下一个单元格，该单元格在代码中称为
rng

这可能不是最简单或最优雅的方法，但我会这样做——而且它是有效的！：）
 @Rawrplus的可能重复dee发布的代码就是我在上面使用的代码，但做了一些更改。为什么不使用Copy/PasteSpecial呢？它很有效。但是有一个问题。B&C列得到了完全相同的值的复制。但D列中的值在转置后变为0。正如我所说的-如果公式使用相对单元格引用，则将引用新单元格。例如，如果在单元格
D4
中有以下公式：
=B4*C4
并将其转置到单元格
C10
中，则公式如下所示：
=A10*B10
。这会给单元格
C10
一个新的甚至错误的值。您可以尝试使用如下绝对单元格引用：
=$B$4*$C$4
.oh。。现在它可以正常工作了。谢谢你，伙计。有一件事我想问。此D列具有值，由用户输入。所以，如果用户输入的公式使用相对单元格引用，则