问题
I am working in a project where i have to to copy some text from a web page using Crt A + Crt C then i want to use this Data in Excel the copyed text is about 100 lines with defrent sizes let say on line has a string of 200 chart and the next one has 500 chart . And the 3rd maybe 20 Is there a way to loop over the clipboard Data line and copy them to an array ?
i add the sample of the copied (Making Crt A Crt C in the page ) text:
Note : I removed some Lines
Usernames are XXXXXXXXXXXXXXXXX
DashboardAnalyticsPolicyAdministration
Web Insights
Print View
Start Over
1Select Chart Type
Logs
Apply Filters
2Choose a Timeframe
Custom: 9/1/2015 12:00:00 AM - 9/30/2015 12:00:00 AM
3Select Filters
Add Filter
2.4 TB
2.0 TB
879.9 GB
656.8 GB
472.0 GB
442.4 GB
242.1 GB
213.5 GB
189.3 GB
103.8 GB
Office 365 - SSL Bypass
Professional Services
Streaming Media
Sites everyone
Internet Services
Corporate Marketing
Miscellaneous
Web Search
News and Media
Social Networking
URL CategoryTop 10TransactionsBytes
回答1:
To follow up on my comment, if you follow the instructions from here add a reference to Microsoft Forms Library 2.0 (under Tools/References in the VBA editor), the following function takes the contents of the clipboard and splits it into lines:
Function ClipToArray() As Variant
Dim clip As New MSForms.DataObject
Dim lines As String
clip.GetFromClipboard
lines = clip.GetText
lines = Replace(lines, vbCr, "")
ClipToArray = Split(lines, vbLf)
End Function
You can test it like this:
Sub test()
Dim A As Variant
Dim i As Long
A = ClipToArray()
For i = LBound(A) To UBound(A)
Debug.Print A(i)
Next i
End Sub
Then I went to this website and copied the poem and then ran test. I got the following output in the immediate window:
Some say the world will end in fire,
Some say in ice.
From what I've tasted of desire
I hold with those who favor fire.
But if it had to perish twice,
I think I know enough of hate
To say that for destruction ice
Is also great
And would suffice.
This worked nicely enough, although you don't have to run many experiments with text copied from the internet before you see that the superficial parsing using split leaves much to be desired.
回答2:
I made this for those who want to extract 2D information from a copied range.
'Display the content of the clipboard
Sub test()
Dim A As Variant
Dim i As Long
A = ClipToArray()
For i = LBound(A, 1) To UBound(A, 1)
tmp = ""
For j = LBound(A, 2) To UBound(A, 2)
tmp = tmp & A(i, j) & " | "
Next
Debug.Print tmp
Next
End Sub
'Made by LePatay on 2018/12/07
'Extract a 2D array from a copied 2D range
Function ClipToArray()
'Include Tools -> References -> Microsoft Forms 2.0 Object Library
'or you will get a "Compile error: user-defined type not defined"
Dim dataobj As New MSForms.DataObject
Dim array2Dfitted As Variant
Dim cbString As String
'Special characters
quote = """"
tabkey = vbTab
CarrReturn = vbCr
LineFeed = vbLf
'Get the string stored in the clipboard
dataobj.GetFromClipboard
On Error GoTo TheEnd
cbString = dataobj.GetText
On Error GoTo 0
'Note: inside a cell, you only find "vbLf";
'at the end of each row, you find "vbCrLf", which is actually "vbCr & vbLf".
cbString = Replace(cbString, vbCrLf, CarrReturn)
'Length of the string
nbChar = Len(cbString)
'Get the number of rows
nbRows = Application.Max(1, nbChar - Len(Replace(cbString, CarrReturn, "")))
'Get the maximum number of columns possible
nbColumnsMax = nbChar - Len(Replace(cbString, tabkey, "")) + 1
'Initialise a 2D array
Dim array2D As Variant
ReDim array2D(1 To nbRows, 1 To nbColumnsMax)
'Initial position in array2D (1st cell)
curRow = 1
curColumn = 1
'Initialise the actual number of columns
nbColumns = curColumn
'Initialise the previous character
prevChar = ""
'Browse the string
For i = 1 To nbChar
'Boolean "copy the character"
bCopy = True
'Boolean "reinitialise the previous character"
bResetPrev = False
'For each character
curChar = Mid(cbString, i, 1)
Select Case curChar
'If it's a quote
Case quote:
'If the previous character is a quote
If prevChar = quote Then
'Indicates that the previous character must be reinitialised
'(in case of a succession of quotes)
bResetPrev = True
Else
'Indicates the character must not be copied
bCopy = False
End If
'If it's a tab
Case tabkey:
'Indicates the character must not be copied
bCopy = False
'Skip to the next column
curColumn = curColumn + 1
'Updates the actual number of columns
nbColumns = Application.Max(curColumn, nbColumns)
'If it's a carriage return
Case CarrReturn:
'Indicates the character must not be copied
bCopy = False
'If it's not the 1st character
If i > 1 Then
'Skip to the next row
curRow = curRow + 1
curColumn = 1
End If
End Select
'If the character must be copied
If bCopy Then
'Adds the character to the current cell
array2D(curRow, curColumn) = array2D(curRow, curColumn) & curChar
End If
'If the previous character must be reinitialised
If bResetPrev Then
prevChar = ""
Else
'Saves the character
prevChar = curChar
End If
Next
'Create a 2D array with the correct dimensions
ReDim array2Dfitted(1 To nbRows, 1 To nbColumns)
'Copies the data from the big array to the fitted one (no useless columns)
For r = 1 To nbRows
For c = 1 To nbColumns
array2Dfitted(r, c) = array2D(r, c)
Next
Next
TheEnd:
ClipToArray = array2Dfitted
End Function
Remarks:
- There is no way to tell if cells are merged).
- This code is robust to quotes, successions of quotes, and multiple lines inside a cell.
- It has been tested on a French Excel, Win 7 64 bit. The system of quotes / carriage returns / line feeds may differ on your OS.
来源：https://stackoverflow.com/questions/33156317/vba-excel-copy-clipboard-data-to-array