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

Liên hệ QC
N

nttcntn

Thành viên chính thức
Tham gia
21/1/10
Bài viết
89
Được thích
29
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.
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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.
Nhấp chuột vào đây để mở rộng...

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?
 
Upvote 0
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}")
Nhấp chuột vào đây để mở rộng...

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!
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...
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 ...........
 
Upvote 0
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 ...........
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
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
 
Upvote 0
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 độ

 

File đính kèm

  • file goc.rar
    1.6 KB · Đọc: 48
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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.
 

File đính kèm

  • Clipboad to Array.xlsm
    15.3 KB · Đọc: 33
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...

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
 

File đính kèm

  • Clipboard2Array.xlsm
    23.5 KB · Đọc: 95
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Hay Ghê ..................Cảm ơn Anh
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

T
  • Question
Dãn dòng tự động
Trả lời
0
Đọc
24
thanhlongenet
T
dunghtgiga
Không cho người khác chỉnh sửa nội dung bảng tính
Trả lời
3
Đọc
98
YêuCN
Y
T
Thống kê ngày hết hạn của sản phẩm
Trả lời
11
Đọc
233
tranphuson
T
T
tự động giãn dòng theo dữ liệu
    • Buồn
Trả lời
2
Đọc
53
SA_DQ
SA_DQ
T
Hướng dẫn lấy dữ liệu từ sheet1 sang sheet2 bằng VBA
2
Trả lời
24
Đọc
2K
meomap1904
meomap1904
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom