Question

希望你们都做得很好。我正在制作一本工作簿，其中我有一列10个连续的单元格。

在另一张表格中有一行我要将这些数据粘贴为转置，但问题是，该行中的某些单元格不连续，其中一些单元格被隐藏。像在图像：

现在我想将数据仅作为转置粘贴到可见单元格，并且这些单元格必须粘贴为链接，就像对第一张纸张所做的任何更改一样，第二张纸张中的相对单元格也应该更改。幸运的是，我已经做了很多工作，因为我发现如何只通过遵循VBA代码粘贴到可见单元格：

Sub PasteToVisible()
'Declarations
Dim Range1            As Range
Dim Range2            As Range
Dim InputRange      As Range
Dim OutputRange     As Range

'Prompt Box Title
xTitleId = "Paste to Visible"
'Start Input Range
Set InputRange = Application.Selection
'Select input range box
Set InputRange = Application.InputBox("Copy Range :", xTitleId, InputRange.Address, Type:=8)
'Select output range box
Set OutputRange = Application.InputBox("Paste Range:", xTitleId, Type:=8)
'Loop to paste the range in visible cells
For Each Range1 In InputRange
    Range1.Copy
    For Each Range2 In OutputRange
        If Range2.EntireRow.RowHeight > 0 Then
            Range2.PasteSpecial
            Set OutputRange = Range2.Offset(1).Resize(OutputRange.Rows.Count)
            Exit For
        End If
    Next
Next
Application.CutCopyMode = False

结束子'

这可以将值粘贴到可见单元格，但仅限于列（非转置）。对于Transpose和Link，我使用Transpose的简单excel公式，如下图所示：

这可以链接转置表单中的值。我想在一个步骤中将所有三个函数（粘贴到可见，转置和作为链接）组合在一起。请帮帮我。我将非常感谢任何建议和帮助。提前谢谢。

Answer 1

正如评论中所述，这是我在评论中发布的示例。

select t1.Name, t1.days, 100 * t1.days / (select sum(t2.days) from table t2) as Percentage
from table t1

我在 Ctrl + Shift + C 快捷方式中指定了它它将复制当前选择，然后提示您输入目标单元格只需选择目标单元格（单个单元格即可），它将粘贴链接尚未优化但我希望这会给你一个想法。

Answer 2

您无法使用内置的Excel pastespecial，transpose和link单元格。

从here调整一个想法，你可以创建一个命名范围，然后参考它。

命名范围称为myRange，您选择范围"A2:A6"，转到名称框，输入文本"myRange"并按Enter键。然后，您可以从Name Box中选择myRange以验证输入是否正确。或者 Ctrl + F3 打开Name Manager。

函数是@BrettDJ，它从数字返回列字母。

请注意，您可以将其重构为一个更通用的函数，该函数接受输入范围和目标单元格并执行其他所有操作，然后从提示选择范围的按钮push sub调用此函数。

 Option Explicit

Public Sub TransposeDataWithLink()

    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet2")
    Dim numColumns As Long
    numColumns = ws.Range("myRange").Rows.Count

    Dim startColumn As Long
    startColumn = 3 'this would be inputted in call
    Dim startRow As Long
    startRow = 2 ''this would be inputted in call

    Dim visibleColumns As Long
    Dim currCell As Range
    Dim myRangeStartCol As Long
    Dim myRangeStartRow As Long

    myRangeStartCol = ws.Range("myRange").Column
    myRangeStartRow = ws.Range("myRange").Row

    Dim columnLetter As String

    columnLetter = Col_Letter(myRangeStartCol)

    Do Until visibleColumns = numColumns

        Set currCell = ws.Cells(startRow, startColumn)

        If currCell.EntireColumn.Hidden = False Then

            visibleColumns = visibleColumns + 1

            Dim myRangeRef As String
            myRangeRef = "=" & columnLetter & CStr(myRangeStartRow + visibleColumns - 1)

            currCell.Formula = myRangeRef

        End If

        startColumn = startColumn + 1

    Loop

End Sub


Public Function Col_Letter(ByVal lngCol As Long) As String
    Dim vArr
    vArr = Split(ActiveSheet.Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

Answer 3

所以，就像L42一样。我找到了解决问题的方法。

Sub marine()

'Key board shortcut Ctrl + Shift + C

Dim cr As Range, dr As Range, c As Range
Dim xTitleId As String
Dim i As Integer

xTitleId = "Paste to Visible"
If TypeOf Selection Is Range Then Set cr = Selection

On Error Resume Next
Set dr = Application.InputBox("Destination Range: ", xTitleId, , , , , , 8)
On Error GoTo 0

If Not dr Is Nothing Then
    Set dr = dr.Resize(1, 1)
    i = 0
    For Each c In cr
        Do While dr.Offset(, i).EntireColumn.Hidden
            i = i + 1
        Loop
        dr.Offset(, i).Formula = "=" & c.Address(, , , True)
        i = i + 1
    Next
End If                                                                    
End Sub

这很有效。

Excel粘贴到可见，Transpose as Link组合功能

3 个答案: