-1

さまざまなワークシートに配置された数千の定義済みの名前領域を持つワークブックがあります。それらをすべて抽出して、別のワークブックに並べようとしています。

定義された名前領域のほとんどは 1 行の高さ (および数百列の幅) ですが、3 ～ 4 行の高さのものもいくつかあります。

たとえば、

名前1

10 5 10 12 30 10 12 10 5 10 12 30 10 12 ...

名前2

10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...
10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...
10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...

リージョンの高さが複数行ある場合、列全体の SUM を取得して 1 行にまとめたいと思います。

したがって、Name2は次のように新しいワークブックにコピーされます。

30 33 30 36 90 30 36 30 33 30 36 90 30 36

リージョンの高さが 1 行の場合に完全に (そして高速に!) 動作する VBA/VBS を作成しましたが、より高いリージョンを効率的に合計する方法がわかりません。

以下の疑問符を埋める最良の方法は何ですか?

これまでのところ、私のコードでは、領域のセルを明示的にループする必要はありませんでした。ここでもそうならないことを願っています。アドバイスをいただければ幸いです。

Dim irow
irow = 0
Dim colsum

'rem Loop through all names and copy over the valid ones
For Each nm in wbSource.Names

    'rem Dont copy any name that isnt visible
    If nm.Visible = True Then

        'rem Only copy valid references that start with "ByWeek"
        If InStr(1, nm.RefersTo, "#REF") = 0 And InStr(1, nm.Name, "ByWeek") > 0 Then

            'rem Only copy if the range is one row tall
            If nm.RefersToRange.Row.Count = 1 Then
                wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
                wsDest.Range("A3",wsDest.Cells(3,nm.RefersToRange.Columns.Count+1)).Offset(irow, 1).Value = nm.RefersToRange.Value
                irow = irow + 1     

            ' rem If the named region is several rows tall, then squish it into one row by taking SUM of each column
            elseif  nm.RefersToRange.Row.Count > 1 Then
                wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
                ???????????????????????????????????
                irow = irow + 1                     

            End If      
        End If  
    End if
Next
4

3 に答える 3

1

誰もが自分のやり方が最善だと思うかもしれないので、最善の方法はありません。

配列ははるかに高速だったので、範囲オブジェクトを直接操作する代わりに配列を使用することをお勧めします。

検討

ここに画像の説明を入力

コードを実行中

Option Explicit

Sub Main()

    Dim lastRow As Long
    Dim lastCol As Long

    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

    Dim arr As Variant
    arr = Range(Cells(1, 1), Cells(lastRow, lastCol))

    ReDim sumArr(UBound(arr, 2)) As Variant
    Dim i As Long
    Dim j As Long
    Dim colSum As Long

    For i = LBound(arr, 1) To UBound(arr, 2)
        For j = LBound(arr, 1) To UBound(arr, 1)
            colSum = colSum + arr(j, i)
        Next j
        sumArr(i) = colSum
        colSum = 0
    Next i

    ReDim finalArray(UBound(sumArr) - 1) As Variant
    For i = 1 To UBound(sumArr)
        finalArray(i - 1) = sumArr(i)
    Next i

    Range("A10").Resize(1, UBound(finalArray, 1) + 1) = finalArray

End Sub

結果は

ここに画像の説明を入力

配列を使用するアイデアはhereから取得されます

あとは、配列を再印刷する範囲を変更するだけです

Range("A10").Resize(1, UBound(finalArray, 1) + 1) = finalArray

したがって、上記のコードを使用する場合、変更する必要があるのは

wsDest.Range("A3").Resize(1, UBound(finalArray, 1) + 1) = finalArray
于 2013-10-28T09:33:07.410 に答える