将字符串分配给单元格的方式与活动表相同.PasteSpecial

Question

我想将字符串的值分配给与ActiveSheet相同的单元格。PasteSpecial方法(我的意思是，vbTab作为tab工作，vbNewLine作为enter工作)，但不必将字符串的值发送到剪贴板。

下面的例程发送"one"到单元格(1,1)，" 2 "单元格(1,2)和" 3 "细胞(2,1)。我想得到同样的结果，但只有通过分配字符串变量的值单元格(1,1)，而不必[1]发送字符串值到剪贴板，[2]选择所需的单元格，[3]使用活动表。PasteSpecial方法。

Sub Test_1() 'This uses the clipboard
Dim MyData As DataObject, s as string
Set MyData = New DataObject
s = "one" & vbTab & "two" & vbNewLine & "three"
MyData.SetText s
MyData.PutInClipboard
ActiveSheet.PasteSpecial Format:="Text"
End Sub

下一个例程不起作用。它将整个文本发送到单元格(1,1)(vbTab不起作用，并且vbNewLine发送单词"three"到单元格(1,1)的第二行。

Sub Test_2() 'This doesn't work as desired
Dim s As String
s = "one" & vbTab & "two" & vbNewLine & "three"
Cells(1, 1) = s
End Sub

Answer 1

我想没有内置的功能来做到这一点。如果你在一个单元格中有内容"one" & vbTab & "two" & vbNewLine & "three"，并使用copy &pastespecel，它会将单元格的全部内容复制到一个目标单元格中。

试试下面的例程。它将首先将字符串拆分为单独的行Split(s, vbNewLine)，然后在行上循环并按制表符Split(lines(lineNo), vbTab)拆分内容。然后将第二次分割的结果写入一行的单元格中。

Sub InsteadOfPasteSpecial(s As String, startCell As Range)

Dim lines() As String, lineNo As Long
lines = Split(s, vbNewLine)
For lineNo = 0 To UBound(lines)
Dim cols() As String
If lines(lineNo) <> "" Then
cols = Split(lines(lineNo), vbTab)
startCell.Offset(lineNo).Resize(1, UBound(cols) + 1).Value = cols
End If
Next
End Sub

Answer 2

试试下面的代码:

Sub Test_2()
Dim s As String
s = "one" & vbTab & "two" & vbNewLine & "three"

Call SubDistribution(s, Cells(1, 1))

End Sub
Sub SubDistribution(StrMessage As String, RngTopLeftCell As Range)

'Declarations
Dim StrString As String
Dim RngSeed As Range
Dim DblRowOffset As Double
Dim DblColumnOffset As Double
Dim DblTabPin As Double
Dim DblNewLinePin As Double

'Settings.
StrString = StrMessage
Set RngSeed = RngTopLeftCell

'Cover the entire StrString.
Do
'Focusing on WorksheetFunction library.
With Excel.WorksheetFunction

'Oversetting DblTabPin and DblNewLinePin in case of error (no vbTab nor vbNewLine found).
DblTabPin = Len(StrString) + 1
DblNewLinePin = Len(StrString) + 1

'Setting DblTabPin and DblNewLinePin as the next vbTab and vbNewLine position in StrString.
On Error Resume Next
DblTabPin = .Find(vbTab, StrString)
DblNewLinePin = .Find(vbNewLine, StrString)
On Error GoTo 0

'Checking if the next vbNewLine is closer than the next vbTab.
If DblTabPin > DblNewLinePin Then

'Reporting the next chunk of StrString in the proper cell.
RngSeed.Offset(DblRowOffset, DblColumnOffset).Value = Split(StrString, vbNewLine)(0)

'Since we have encountered a vbNewLine, DblColumnOffset is set to 0 and DblRowOffset is increased by 1.
DblColumnOffset = 0
DblRowOffset = DblRowOffset + 1

'Cutting off the chunk of StrString just reported in the proper cell.
StrString = .Substitute(StrString, Split(StrString, vbNewLine)(0) & vbNewLine, "", 1)

Else

'Reporting the next chunk of StrString in the proper cell.
RngSeed.Offset(DblRowOffset, DblColumnOffset).Value = Split(StrString, vbTab)(0)

'Since we have encountered a vbTab, DblColumnOffset is increased by 1.
DblColumnOffset = DblColumnOffset + 1

'Cutting off the chunk of StrString just reported in the proper cell.
StrString = .Substitute(StrString, Split(StrString, vbTab)(0) & vbTab, "", 1)
End If


End With

'The only case allowing DblTabPin to be equal to DblNewLinePin is the one with no vbTab nor vbNewLine left in StrString. In such case the loop is left.
Loop Until DblTabPin = DblNewLinePin

End Sub