开发者

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.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜