How can I assign the SpecialCells of one range to a new range?
I know that I can accomplish this via iterating over the first range, but I'm curious to see if I can accomplish it using the SpecialCells
property.
Say I have a column of names with empty cells in between:
A B C
Jon
Jim
Sally
Jane
Mary
If I want to use VBA to copy over just the used cells, I can say
Range("A1:A开发者_开发技巧8").SpecialCells(xlCellTypeConstants, xlTextValues).Copy
Range("C1:C"&Range("A1:A8").SpecialCells(xlCellTypeConstants, xlTextValues).Count).PasteSpecial
and end up with
A B C
Jon Jon
Jim Jim
Sally Sally
Jane
Jane Mary
Mary
Instead, I'd like to be able to do this without having to paste a range anywhere.
What I want to be able to do is have a range containing [Jon,Jim,Sally,Jane,Mary]
, but if I try Set rng = Range("A:A").SpecialCells(xlCellTypeConstants,xlTextValues)
, I either end up with the spaces as elements of the range, or using a hard-coded range of cells, with one that counts only [Jon, Jim, Sally]
before it hits the space.
I'd like to be able to use the range elsewhere in the code, and I think the SpecialCells is a nice compact way of doing it, but is my only alternative to do it in a loop and compare cells as <> ""
?
Consider the following code:
Dim r As Range
Set r = Range("A:A").SpecialCells(xlCellTypeConstants, xlTextValues)
Debug.Print r.Rows.Count, r.Cells.Count
' returns: 3 5
The only reliable piece of information in the above is r.Cells.Count
. The Rows
get cut at the first blank. I imagine this confuses the whole pasting process. So, you can't paste r
directly to the worksheet.
You could transfer it to a Variant array, and then slap* that onto the sheet. But how to do this? Well, r.Cells
is akin to a collection. Perhaps convert it to an array like this:
Dim i As Long
Dim c As Range
Dim v As Variant
ReDim v(1 To r.Cells.Count, 1 To 1)
i = 0
For Each c In r
i = i + 1
v(i, 1) = c
Next c
Range("B1").Resize(UBound(v,1),UBound(v,2)) = v
No need to check for empty cells.
You could also use Chip Pearson's CollectionToArray
procedure, which is basically a fancier implementation of the above code, maybe with a bit of modification.
By the way, checking for <> ""
will not reject cells whose value is an empty string ""
. If you must check for truly empty/"blank" cells, then IsEmpty
is safer.
*Credits to @Issun for coining "slap" in this context.
If you really want to just use the specialcells, you'll need to do a for each loop, but here's how to do it without a variant array or checking for empty cell. Note that I am using a dictionary in reverse (see notes below) to store cells as items (not keys) so I can utilize the .Items method that spits out an array of all items in the dictionary.
Sub test()
Dim cell As Range
Dim i As Long
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
For Each cell In Range("A1:A10").SpecialCells(xlCellTypeConstants)
dict.Add i, cell.Value
i = i + 1
Next
Sheet1.Range("c1").Resize(dict.Count).Value = _
Application.Transpose(dict.items)
End Sub
But there is a faster way to do this, in case you are working with a fairly big range. Use the dictionary object since it has the ability to spit out an array of all the keys/items inside it (which you can transpose to a range). Collections do not have this abliity, but dictionaries only allow 1 of each key. The work around? Use the dictionary in reverse, placing your values as items and a counter for keys!
Here's an example of how to use the variant array/dictionary (with dupes allowed):
Sub test()
Dim vArray As Variant
Dim i As Long, j As Long, k As Long
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
vArray = Range("A1:A10").Value
For i = 1 To UBound(vArray, 1)
For j = 1 To UBound(vArray, 2)
If Len(vArray(i, j)) <> 0 Then
dict.Add k, vArray(i, j)
k = k + 1
End If
Next
Next
Sheet1.Range("c1").Resize(dict.Count).Value = _
Application.Transpose(dict.items)
End Sub
This is much faster than using special cells (since VBA handles the work without consulting Excel) and you can use transpose as if it were paste, so I prefer this method.
As JFC has noted, using a dictionary object doesn't really seem to have a lot of benifits, the biggest reason is that it's easy to transpose the array plus you can transpose it horizontally as well, which is very fun.
Sheet1.Range(Cells(1, 3), Cells(1, dict.Count + 2)).Value = _
Application.Transpose(Application.Transpose(dict.items))
Since the Range object represents actual cells (A1
,A2
,A3
,A5
and A8
in this case), I don't think you can compact in a 5-consecutive-cells Range without pasting it anywhere.
However, if you need to to loop on it, you don't need to use a comparison, using For Each
will skip the blanks:
Set Rng = Range("A1:A8").SpecialCells(xlCellTypeConstants, xlTextValues)
Print Rng.count
5
For Each cell in Rng: Print cell: Next cell
Jon
Jim
Sally
Jane
Mary
It's probably not much, but it may help you depending on what you want to achieve.
精彩评论