如何使用 pastespecial 转换 Application.Transpose 以仅放置值而不放置格式？

Question

Dim ar as variable

Sheets("Sheet1").Range("A4").Resize(UBound(ar) + 1) = 
Application.Transpose(ar)

除了粘贴格式外，它工作得很好。我的列表中有奇怪的数字，它应该作为文本粘贴，因为 excel 会将这些数字转换为日期或不同的值。

如何在 Application.Transpose 中添加以下内容？ .PasteSpecial xlPasteValues

Edit2：下面的代码应该对 sheet2 的 B 列中的值进行排序，并将它们转置到 Sheet1 中。但是，它不会转置值。我做错了什么？

Private Sub Workbook_Open()
ThisWorkbook.RefreshAll
DoEvents

Dim r As Range
Dim rng As Range
Dim ar As Variant
Dim var As Variant

With Sheets("Sheet2").Range("B2").CurrentRegion
With CreateObject("scripting.dictionary")
For Each rng In Range("B3", Range("B" & Rows.Count).End(xlUp))
var = .Item(rng.Value)
Next
ar = .Keys
End With
End With
With Sheets("Sheet1").Range("A4").Resize(UBound(ar) + 1)
.NumberFormat = "@"
.Value = Application.Transpose(ar)
End With

Answer 1

您显示的内容根本没有粘贴任何格式（假设 ar 是包含值的变体，而不是单元格范围数组）。

尝试（未测试）：

With Sheets("Sheet1").Range("A4").Resize(UBound(ar) + 1)
    .numberformat = "@"
    .value = Application.Transpose (ar)
end with

编辑：

现在您已经发布了附加代码，显示了您是如何填充 ar 的，现在发生了什么更清楚了。

ar = .Keys

产生一个一维数组。

Sheets("Sheet1").Range("A4").Resize(UBound(ar) + 1)

返回一个垂直单元格范围。

以及您的来源地区：

Range("B3", Range("B" & Rows.Count).End(xlUp))

也是一个垂直区域。

您需要了解如何在 VBA 和工作表之间传递数组。如果链接仍然有效，一个很好的解释是 Chip Pearson 的VBA Arrays and Worksheet Ranges。

您的一维 VBA 数组应转到水平工作表范围。要填充垂直工作表范围，您需要一个二维数组。

并且您的目标范围需要创建为水平范围；您已将其创建为垂直范围。

因此，您的代码的相关部分，经过一些编辑以提高健壮性并缩进以提高可读性，将显示为：

Dim r As Range
Dim rng As Range
Dim ar As Variant
Dim var As Variant

With Worksheets("sheet2")
    Set r = .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
End With


With CreateObject("scripting.dictionary")
    For Each rng In r
        var = .Item(rng.Value)
    Next
    ar = .Keys
End With

With Sheets("Sheet1").Range("A4").Resize(columnsize:=UBound(ar) + 1)
    .NumberFormat = "@"
    .Value = ar
End With

End Sub

这会将来自Sheet2!B3:Bn 的垂直范围的数据粘贴到从Sheet1!A4 开始的水平范围中。这就是我认为你想要的。

编辑 2：

除非您出于其他原因使用 Dictionary 对象，否则代码的更短、等效版本将是：

  Dim ar As Variant
  Dim var As Variant

With Worksheets("sheet2")
    ar = .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
End With

With Sheets("Sheet1").Range("A4").Resize(columnsize:=UBound(ar))
    .NumberFormat = "@"
    .Value = WorksheetFunction.Transpose(ar)
End With

请注意，在这种情况下，

• 我们只需一步即可填充 VBA 数组
• 在调整目标范围时，我们不添加+1
• 我们做在将数组写入目标之前转置数组

如果你通读了上面的参考资料，你应该能够弄清楚这些变化的逻辑。

Answer 2

让这段代码垂直粘贴而不是水平粘贴会有什么变化？通过将 ColumnSize 更改为 RowSize，值会垂直粘贴，但不会对所有值进行排序。 IE 1,2,3,4,5 它只会粘贴 1,1,1,1,1

Dim r As Range
Dim rng As Range
Dim ar As Variant
Dim var As Variant

With Worksheets("Sheet2")
  Set r = .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
End With


With CreateObject("scripting.dictionary")
    For Each rng In r
        var = .Item(rng.Value)
    Next
    ar = .Keys
End With

With Sheets("Sheet1").Range("A4").Resize(RowSize:=UBound(ar) + 1)
    .NumberFormat = "@"
    .Value = ar
End With

End Sub