Excel VBA 셀의 값만 복사

9686 단어 VBAExcelExcelVBA

DataObject



셀의 값만 복사하는 방법으로 DataObject를 사용하는 방법이 있습니다.

Sub ValueCopy1()
    With New DataObject
        .SetText ActiveCell
        .PutInClipboard
    End With
End Sub

그러나, 이 방법으로 잘 복사할 수 없는 때가 있습니다.
제 경우에는 「・・」가 되어 있거나, 형식을 텍스트로 해 붙여 붙이면 「??」가 되거나 합니다.


또 다른 방법은 텍스트 상자를 사용하여 복사하는 것입니다.

TextBox.Copy


Sub Main()
    Call ValueCopy2(ActiveCell)
End Sub

Sub ValueCopy2(value As String)
    With CreateObject("Forms.TextBox.1")
        .MultiLine = True
        .text = value
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
  End With
End Sub

결과


잘 복사할 수 있었습니다.
다만, 이 경우, 1개의 셀 밖에 카피할 수 없기 때문에, 좀 더 궁리합니다.

선택한 셀의 모든 값 복사



Sub Main()
    Call ValueCopy(SelectionCellsValue(Selection))
End Sub

Function SelectionCellsValue(ra As Range) As String
    Dim count As Integer: count = ra.Row
    Dim first As Boolean: first = True
    Dim r As Range
    Dim value As String
    For Each r In ra
        If first Then
            value = r.value
            first = False
        ElseIf r.Row = count Then
            value = value & vbTab & r.value 'vbTabは半角スペースでもいいかも(お好みで)
        Else
            value = value & vbCrLf & r.value
            count = count + 1
        End If
    Next r
    SelectionCellsValue = value
End Function

Sub ValueCopy3(value As String)
    With CreateObject("Forms.TextBox.1")
        .MultiLine = True
        .text = value
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
  End With
End Sub

결과

선택한 범위 모두 복사할 수 있었습니다.
나중에 Main을 단축키 Ctrl + Shift + C 등에 할당하면 편리합니다.

참고 사이트



[VBA] DataObject를 사용한 클립보드 작업이 잘 되지 않는 경우의 해결 방법

추가



↑ 어째서 이런 긴 것 같아? first 있나요?
마음에 들지 않았기 때문에 다시 작성했습니다.
Sub CellsValueCopy()
    Dim row As Integer: row = ActiveCell.row
    Dim rng As Range
    Dim value As String
    For Each rng In Selection
        If rng.row = row Then
            value = value & rng.value & " "
        Else
            value = Left(value, Len(value) - 1) & vbCrLf & rng.value & " "
            row = rng.row
        End If
    Next rng
    Call ValueCopy(Left(value, Len(value) - 1))
End Sub

좋은 웹페이지 즐겨찾기