[已解决]Usedrange问题

张雄友

由于数据并不是在A列开始的，有的在B列开始的如表《B》，怎么修改成通用？

arr = sh.Range("A1").Resize(sh.Range("a65536").End(xlUp).Row, c.CurrentRegion.Columns.Count)

这句怎么改才好？

最佳答案

月排行榜 / 总排行榜

1032446692

2013-6-9 10:41

Sub 合并()
Application.ScreenUpdating = False
Dim sh As Worksheet, arr, brr(0 To 65535, 1 To 255)
    Dim d As Object, i&, j&, m&, n&, f&, c As Range
    Set d = CreateObject("scripting.dictionary")
    d("部门名称") = 1
    brr(0, 1) = "部门名称"
    n = 1
    For Each sh In Worksheets
        If sh.Name <> "汇总" Then
            sh.Select
            Set c = sh.Cells.Find("部门名称", , , 1)
            arr = c.Resize(c.CurrentRegion.Rows.Count, c.CurrentRegion.Columns.Count)
            f = c.Row
            For j = 1 To UBound(arr, 2)
                If Not d.Exists(arr(1, j)) And arr(1, j) <> "" Then
                    n = n + 1
                    d(arr(1, j)) = n
                    brr(0, n) = arr(1, j)
                End If
            Next
            For i = 2 To UBound(arr)
                m = m + 1
                brr(m, 1) = arr(i, 1)
                For j = 2 To UBound(arr, 2)
                   If arr(1, j) <> "" Then brr(m, d(arr(1, j))) = arr(i, j)
                Next
            Next
        End If
    Next
    Sheets("汇总").Select
    Cells.ClearContents
    [a1].Resize(m + 1, n + 1) = brr
    Application.ScreenUpdating = True

End Sub

跳转到最佳答案楼层

hoogle

temp=iif(sh.Range("a65536").End(xlUp).Row>sh.Range("b65536").End(xlUp).Row,sh.Range("a65536").End(xlUp).Row,sh.Range("b65536").End(xlUp).Row)
arr = sh.Range("A1").Resize(temp, c.CurrentRegion.Columns.Count)
换成这两句代码

张雄友

hoogle 发表于 2013-6-7 20:12
temp=iif(sh.Range("a65536").End(xlUp).Row>sh.Range("b65536").End(xlUp).Row,sh.Range("a65536").End(xl ...

但如果有的在C列，或者E列，开始的话，又怎么改？主要是不确定。

hoogle

Dim i, imax
For i = 1 To 26
    If Cells(65536, i).End(3).Row > imax Then imax = Cells(65536, i).End(3).Row
Next
imax就是你要的值

张雄友

hoogle 发表于 2013-6-7 20:18
Dim i, imax
For i = 1 To 26
    If Cells(65536, i).End(3).Row > imax Then imax = Cells(65536, i).E ...

师傅可以将代码写完整？加入原代码中去？谢谢师傅了。

对了，For i = 1 To 26  ？最大列数是256吧？师傅？

hoogle

我是举个例子，写了个26。
代码你自己加，顺便练习下！

张雄友

hoogle 发表于 2013-6-7 20:22
我是举个例子，写了个26。
代码你自己加，顺便练习下！

刚来，功夫未到位，可以帮改一下吗？真心谢谢。

1032446692

Sub 合并()
Application.ScreenUpdating = False

Dim sh As Worksheet, arr, brr(0 To 65535, 1 To 255)
    Dim d As Object, i&, j&, m&, n&, f&, c As Range
    Set d = CreateObject("scripting.dictionary")
    d("部门名称") = 1
    brr(0, 1) = "部门名称"
    n = 1
    For Each sh In Worksheets
        If sh.Name <> "汇总" Then
            sh.Select
            Set c = sh.Cells.Find("部门名称", , , 1)
            arr = c.Resize(c.CurrentRegion.Rows.Count, c.CurrentRegion.Columns.Count)
            f = c.Row
            For j = 1 To UBound(arr, 2)
                If Not d.Exists(arr(f, j)) Then
                    n = n + 1
                    d(arr(f, j)) = n
                    brr(0, n) = arr(f, j)
                End If
            Next
            For i = f + 1 To UBound(arr)
                m = m + 1
                brr(m, 1) = arr(i, 1)
                For j = 2 To UBound(arr, 2)
                    brr(m, d(arr(f, j))) = arr(i, j)
                Next
            Next
        End If
    Next
    Cells.ClearContents
    [a1].Resize(m + 1, n + 1) = brr
    Application.ScreenUpdating = True

End Sub

1032446692

只修改你要修改的那一块  

1032446692

达到你的要求了  记得设置为最佳