Cách lấy dữ liệu từ Clipboad vào mảng bằng VBA

nttcntn · 22/8/16

Gửi thành viên trong diễn đàn!
Mình đang có vấn đề như trên tiêu đề có bác nào biết thì trợ giúp mình với.
Việc copy vào clipboad được copy từ Excel thôi.

ndu96081631 · 22/8/16

nttcntn đã viết:
Gửi thành viên trong diễn đàn!
Mình đang có vấn đề như trên tiêu đề có bác nào biết thì trợ giúp mình với.
Việc copy vào clipboad được copy từ Excel thôi.

Câu trả lời là LÀM ĐƯỢC
Nhưng tôi tò mò muốn biết sau khi đã có mảng kết quả, bạn sẽ làm gì tiếp theo?

Kiều Mạnh · 22/8/16

ndu96081631 đã viết:
Câu trả lời là LÀM ĐƯỢC
Nhưng tôi tò mò muốn biết sau khi đã có mảng kết quả, bạn sẽ làm gì tiếp theo?

Vụ này Em nghi Anh xài dòng sau Quá

Set clb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

ndu96081631 · 22/8/16

kieu manh đã viết:
Vụ này Em nghi Anh xài dòng sau Quá

Set clb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

Chuyện đương nhiên rồi (thuật toán cũng khá đơn giản)
Nhưng vấn đề rắc rối không nằm ở đó. Bẫy lỗi mới là thứ khủng khiếp nhất (ai mà biết người ta đã copy thứ gì)
Mình nghĩ kieu manh thừa sức làm bài này. Thử xem!

Kiều Mạnh · 22/8/16

ndu96081631 đã viết:
Chuyện đương nhiên rồi (thuật toán cũng khá đơn giản)
Nhưng vấn đề rắc rối không nằm ở đó. Bẫy lỗi mới là thứ khủng khiếp nhất (ai mà biết người ta đã copy thứ gì)
Mình nghĩ kieu manh thừa sức làm bài này. Thử xem!

Thì cái này Em cũng học của Anh thôi mà ....Em nghĩ Viết theo cách Set đó hay hơn mấy hàm API nhiều

OpenClipboard, CopyMemory, GetClipboardData ...........

ndu96081631 · 22/8/16

kieu manh đã viết:
Thì cái này Em cũng học của Anh thôi mà ....Em nghĩ Viết theo cách Set đó hay hơn mấy hàm API nhiều

OpenClipboard, CopyMemory, GetClipboardData ...........

Mình không nghĩ DataObject hay hơn API đâu, bởi API xử lý Clipboard đa dạng hơn rất nhiều.
Tuy nhiên nếu chỉ copy dữ liệu từ bảng tính (không có object nào cả) thì DataObject là vừa đủ xài (khỏi xài sang làm gì). Với lại mình không phải cao thủ API nên dùng cái này mệt đầu lắm

anhdepjai · 23/8/16

kieu manh đã viết:
Thì cái này Em cũng học của Anh thôi mà ....Em nghĩ Viết theo cách Set đó hay hơn mấy hàm API nhiều

OpenClipboard, CopyMemory, GetClipboardData ...........

Kiều Mạnh cho xin 1 vài ví dụ để mình học hỏi với, biết đâu áp dụng được cho công việc.

Thanks

Kiều Mạnh · 23/8/16

anhdepjai đã viết:
Kiều Mạnh cho xin 1 vài ví dụ để mình học hỏi với, biết đâu áp dụng được cho công việc.

Thanks

Thì cách sử dụng DataObject Mình học của Anh Ndu Link Sau

http://www.giaiphapexcel.com/forum/...-chuỗi-đặc-biệt-trong-1-ô-thành-nhiều-dòng!!!

Bạn Tham Khảo Thêm

https://desmondoshiwambo.wordpress....-tofrom-clipboard-using-vba-microsoft-access/

Hay Sử dụng Hàm API ... Như Mớ Code Sau:

Mã:

Private Const CF_UNICODETEXT As Long = 13
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

Ví dụ đơn Giản thì như vầy: Copy [A1] Paste [D4]

Mã:

Sub CopyToClipboard()
    Dim text
    Dim clb As Object
    text = Sheet1.Range("A1").Value
    Set clb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    clb.SetText text
    clb.PutInClipboard
    Sheet1.Range("D4").PasteSpecial
    Set clb = Nothing
End Sub

Ngoài ra Bạn có thể kết Hợp DataObject + Fso [CreateObject("Scripting.FileSystemObject")]

lấy dữ liệu từ File Txt gán vào Clipboard xong gán lên Sheet xong Bạn muốn hoài cũng ok Cứ chọn Cells x xong Ctrl+V là lại có nữa

huuthang_bd · 23/8/16

kieu manh đã viết:
Ví dụ đơn Giản thì như vầy: Copy [A1] Paste [D4]

Mã:

Sub CopyToClipboard() Dim text Dim clb As Object text = Sheet1.Range("A1").Value Set clb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") clb.SetText text clb.PutInClipboard Sheet1.Range("D4").PasteSpecial Set clb = Nothing End Sub

Ngoài ra Bạn có thể kết Hợp DataObject + Fso [CreateObject("Scripting.FileSystemObject")]

lấy dữ liệu từ File Txt gán vào Clipboard xong gán lên Sheet xong Bạn muốn hoài cũng ok Cứ chọn Cells x xong Ctrl+V là lại có nữa

Hình như cái này là đưa dữ liệu vào Clipboard chứ không phải lấy dữ liệu từ Clipboard

Kiều Mạnh · 23/8/16

huuthang_bd đã viết:
Hình như cái này là đưa dữ liệu vào Clipboard chứ không phải lấy dữ liệu từ Clipboard

Thì Tỷ dụ vậy ... thì đưa nó vào xong mới lấy ra được chứ ... --=0

Nếu nó đang ở EmptyClipboard thì có gì lấy ...

Thì thử code Sau xem nó đưa vào xong Paste xuống Sheet xong xóa [EmptyClipboard] luôn ko thể Ctrl+V hoài được nữa

Mã:

Sub CopyToClipboard()
    Dim text
    Dim clb As Object
    text = Sheet1.Range("A1").Value
    Set clb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    clb.SetText text
    clb.PutInClipboard
    Sheet1.Range("D4").PasteSpecial
   [COLOR=#ff0000][B] clb.Clear [/B][/COLOR]  [COLOR=#0000ff][B]''Nếu bỏ dòng này chạy code xong cứ Ctrl+v Hoài khi nào mõi tay thì nghỉ[/B][/COLOR]
    Set clb = Nothing
End Sub

anhdepjai · 23/8/16

Mình sửa thử thế này
text = Sheet4.Range("A1:L7").Value

nó báo lỗi ở dòng này
clb.SetText text

Vậy cái này là copy theo từng ô ah Kiều Mạnh

Kiều Mạnh · 23/8/16

Thấy quậy cái món này cũng hay ...Mạnh Gửi File Sau lên ta Ngâm Cứu

1/ Sử dụng Fso lấy dữ liệu lên gán vào Clipboard xong gán xuống Sheet y trang như vậy (cái mớ bòng bong đó)

2/ Xem cách viết code nào xúc tích ngắn gọn nhất và Tốc độ

Kiều Mạnh · 23/8/16

anhdepjai đã viết:
Mình sửa thử thế này
text = Sheet4.Range("A1:L7").Value

nó báo lỗi ở dòng này
clb.SetText text

Vậy cái này là copy theo từng ô ah Kiều Mạnh

Code đó Áp dụng cho 1 cells còn nhiều Cells lỗi code ...Bạn nghiên cứu bài Anh ndu link trên

nttcntn · 23/8/16

Em có file đính kèm mong mọi người giúp.
Cái em bị mắc chính là dữ liệu trong file mình cần không liền mạch.

ndu96081631 · 23/8/16

nttcntn đã viết:
Em có file đính kèm mong mọi người giúp.
Cái em bị mắc chính là dữ liệu trong file mình cần không liền mạch.

Biết ngay là có giấu "càn khôn" gì đó mà (nên tôi phải hỏi lại cho chắc!
--------------------------------
Tôi thiết kế code thế này:
1> Code trong Module

Mã:

Function Clipboard2Array()
  Dim sTmp As String
  Dim objClb As Object
  Dim aTmp1, aTmp2
  Dim lR As Long, lRs As Long, lC As Long, lCs As Long
  'On Error Resume Next
  If Application.CutCopyMode > 0 Then  ''Có hành dong copy trên Range moi tiep tuc
    Set objClb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    objClb.GetFromClipboard
    sTmp = objClb.GetText
    If Len(sTmp) Then
      If Right(sTmp, 2) = vbCrLf Then sTmp = Left(sTmp, Len(sTmp) - 2)
      aTmp1 = Split(sTmp, vbCrLf)
      If UBound(aTmp1) > -1 Then  ''aTmp1 phai la mot Array thì moi tiep tuc
        lRs = UBound(aTmp1) + 1
        ReDim aRes(1 To lRs, 1 To 1)
        For lR = 1 To lRs
          aTmp2 = Split(aTmp1(lR - 1), vbTab)
          If lCs = 0 Then  ''Gán lCs 1 lan duy nhat
            lCs = UBound(aTmp2) + 1
            If lCs Then ReDim Preserve aRes(1 To lRs, 1 To lCs)
          End If
          If lCs Then  ''aTmp2 phai la mot Array thì moi tiep tuc
            For lC = 1 To lCs
              aRes(lR, lC) = aTmp2(lC - 1)
            Next
          End If
        Next
        If lRs * lCs Then Clipboard2Array = aRes
      End If
    End If
    Set objClb = Nothing
  End If
End Function
Sub ShowForm()
  ufTest.Show False
End Sub

(ufTest là tên của UserForm)
2> Code trong UserForm
Tôi thiết kế UserForm với 1 CommandButton và 1 ListBox với mục đích test code. Nếu code thực hiện được việc biến giá trị trong Clipboard thành Array thì ta sẽ thấy ngay kết quả ở ListBox

Mã:

Private Sub CommandButton1_Click()
  Dim arr
  arr = Clipboard2Array
  If IsArray(arr) Then
    With Me.ListBox1
      .ColumnCount = UBound(arr, 2)
      .List = arr
      MsgBox "Done!", , UBound(arr, 1)
    End With
  End If
End Sub

------------------
Mời xem file và kiểm tra vì tôi chưa chắc còn chỗ nào thiếu sót không

nttcntn · 23/8/16

ndu96081631 đã viết:
Mời xem file và kiểm tra vì tôi chưa chắc còn chỗ nào thiếu sót không

Thật tuyệt vời thanh bác ndu96081631!

Kiều Mạnh · 23/8/16

ndu96081631 đã viết:
Biết ngay là có giấu "càn khôn" gì đó mà (nên tôi phải hỏi lại cho chắc!
--------------------------------
Tôi thiết kế code thế này:
1> Code trong Module

Mã:

Function Clipboard2Array() Dim sTmp As String Dim objClb As Object Dim aTmp1, aTmp2 Dim lR As Long, lRs As Long, lC As Long, lCs As Long 'On Error Resume Next If Application.CutCopyMode > 0 Then ''Có hành dong copy trên Range moi tiep tuc Set objClb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objClb.GetFromClipboard sTmp = objClb.GetText If Len(sTmp) Then If Right(sTmp, 2) = vbCrLf Then sTmp = Left(sTmp, Len(sTmp) - 2) aTmp1 = Split(sTmp, vbCrLf) If UBound(aTmp1) > -1 Then ''aTmp1 phai la mot Array thì moi tiep tuc lRs = UBound(aTmp1) + 1 ReDim aRes(1 To lRs, 1 To 1) For lR = 1 To lRs aTmp2 = Split(aTmp1(lR - 1), vbTab) If lCs = 0 Then ''Gán lCs 1 lan duy nhat lCs = UBound(aTmp2) + 1 If lCs Then ReDim Preserve aRes(1 To lRs, 1 To lCs) End If If lCs Then ''aTmp2 phai la mot Array thì moi tiep tuc For lC = 1 To lCs aRes(lR, lC) = aTmp2(lC - 1) Next End If Next If lRs * lCs Then Clipboard2Array = aRes End If End If Set objClb = Nothing End If End Function Sub ShowForm() ufTest.Show False End Sub

(ufTest là tên của UserForm)
2> Code trong UserForm
Tôi thiết kế UserForm với 1 CommandButton và 1 ListBox với mục đích test code. Nếu code thực hiện được việc biến giá trị trong Clipboard thành Array thì ta sẽ thấy ngay kết quả ở ListBox

Mã:

Private Sub CommandButton1_Click() Dim arr arr = Clipboard2Array If IsArray(arr) Then With Me.ListBox1 .ColumnCount = UBound(arr, 2) .List = arr MsgBox "Done!", , UBound(arr, 1) End With End If End Sub

------------------
Mời xem file và kiểm tra vì tôi chưa chắc còn chỗ nào thiếu sót không

Hay Ghê ..................Cảm ơn Anh

ndu96081631 · 24/8/16

kieu manh đã viết:
Hay Ghê ..................Cảm ơn Anh

Chưa hay và khuyết điểm vẫn còn đó

Kiều Mạnh · 24/8/16

ndu96081631 đã viết:
Chưa hay và khuyết điểm vẫn còn đó

Code Anh viết thì Em chỉ học thôi chứ ...khúc Em thấy được khúc không ấy mà ...Anh điều chỉnh lại cho Em học với

ndu96081631 · 24/8/16

kieu manh đã viết:
Code Anh viết thì Em chỉ học thôi chứ ...khúc Em thấy được khúc không ấy mà ...Anh điều chỉnh lại cho Em học với

Khuyết điểm là: Nếu copy vùng dữ liệu không liên tục (không phải Filter) thì array nhận được sẽ không đúng
Tôi không hiểu tại sao khi Ctrl + V thì Excel lại thông minh ở phần này
Đang tìm hiểu và vẫn chưa có đáp án bạn à
Tại tôi muốn hoàn chỉnh hơn thôi chứ riêng về yêu cầu của tác giả thì đã đạt rồi

Cách lấy dữ liệu từ Clipboad vào mảng bằng VBA

Thành viên chính thức

Huyền thoại GPE

I don't program, I beat code into submission!!!

Huyền thoại GPE

I don't program, I beat code into submission!!!

Huyền thoại GPE

Thành viên thường trực

I don't program, I beat code into submission!!!

Chuyên gia GPE

I don't program, I beat code into submission!!!

Thành viên thường trực

I don't program, I beat code into submission!!!

File đính kèm

I don't program, I beat code into submission!!!

Thành viên chính thức

File đính kèm

Huyền thoại GPE

File đính kèm

Thành viên chính thức

I don't program, I beat code into submission!!!

Huyền thoại GPE

I don't program, I beat code into submission!!!

Huyền thoại GPE