首页 文章

使用公式未更改的VBA转置数据

提问于
浏览
-1

代码:

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

我需要用他们的公式转置的范围 .
enter image description here

sourceRowRange 是用户完成的选择,例如:image RangeFilledWithTransposedData 是用户选择用于转置所选范围的单元格 . 用户希望灵活地选择转置范围,并且还足够灵活,可以在当前工作表中的任何位置转置数据 .

如您所见, D3 是公式,即 =B3*C3 . 同样,公式适用于 Column D 中的休息单元格 .

现在,使用上面的代码我面临两个问题:
1.我必须选择输出单元格,您可以在代码中看到 . 但是当我这样做时,只有第一个值粘贴在该输出单元格中,即该值从 B3 打印为"1" . 但是当我为输出单元选择一个范围时,例如与我的选择相同数量的单元格,然后我得到所有转置列 . 这意味着如果我选择2个细胞,那么只有2个细胞将被转置,如果我选择10个细胞,那么将转换10个细胞 . 它不会转移选择中的所有细胞,直到我提供与我的选择相同数量的细胞 .

这些公式没有转置 . 只有来自 column D 的值才会被转置 . 有没有办法用各自的公式转置数据?

1 回答

  • 1

    这应该工作:

    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
    

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

    Explanation of the code:

    myColumns = Selection.Columns.Count
    

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

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

    上面的代码片段会提示 InputBox ,用户可以在其中编写所需的输出单元格 . 输出单元格将成为转置数据的左上角单元格 . 如果用户未键入值, If 语句将退出 sub .

    For Each rng In Selection 循环遍历所选范围内的每个单元格 . 代码首先从左到右循环遍历列,然后向下循环并再次循环遍历列 . 这个循环的一般想法是识别单元格的位置,然后将其粘贴到相应的转置位置 .

    columnCounterrowCounter 跟踪单元格的位置 . columnCounter = 0rowCounter = 0 将是第一个被转置的单元格 . 此单元格粘贴到用户指定的输出单元格 . columnCounter = 1rowCounter = 0 将是要转置的第二个单元格 . 此单元格粘贴在同一列中,但输出单元格下方有一行 .

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

    columnCounter 的值变得大于 myColumns 的值时, columnCounter 的值被设置为 -1 . 当 columnCounter 的值为 -1 时, rowCounter 的值增加 1columnCounter 的值重置为 0 . 这意味着循环已完成遍历一行中的列,现在正在进入下一行 .
    所有这些都可以在以下代码片段中看到:

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

    现在识别出单元格的位置,我们需要将其粘贴到正确的“ output range ”,在代码中称为 Outputrng . 这是在以下行中完成的:

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

    这一行的基础是 Range(userInput) . 这是用户通过 InputBox 指定的原始输出单元格 . 使用 .Offset ,我们可以使用相对于用户指定的输出单元格的单元格 . 由于我们需要转置原始选择,我们使用 columnCounterrowCounter 反转原始单元格的位置 .
    请注意, columnCounter 用作 row offset ,而 rowCounter 用作 column offset .

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

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

    请注意,最后的 1 指定我们需要绝对引用 . 如果我们想要相对引用,只需将 1 更改为 4 .

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

    rng.Copy
    Outputrng.PasteSpecial xlPasteFormulas
    

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

    这可能不是最简单或最优雅的方法,但这就是我会这样做 - 它的工作原理! :)

相关问题