Excel VBA 셀의 값만 복사
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
Reference
이 문제에 관하여(Excel VBA 셀의 값만 복사), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다
https://qiita.com/yoshi_782/items/aea9724553d874af2b9f
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념
(Collection and Share based on the CC Protocol.)
Sub ValueCopy1()
With New DataObject
.SetText ActiveCell
.PutInClipboard
End With
End Sub
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
Reference
이 문제에 관하여(Excel VBA 셀의 값만 복사), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다
https://qiita.com/yoshi_782/items/aea9724553d874af2b9f
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념
(Collection and Share based on the CC Protocol.)
↑ 어째서 이런 긴 것 같아? 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
Reference
이 문제에 관하여(Excel VBA 셀의 값만 복사), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다 https://qiita.com/yoshi_782/items/aea9724553d874af2b9f텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념 (Collection and Share based on the CC Protocol.)