Vba 指定区域中的列值之和

我有一个工作簿，在不同的工作表中有数千个定义的名称区域。我正试图将它们全部提取出来，并将它们排列在另一个工作簿中

大多数已定义的名称区域都有一行高（数百列宽）。。。但也有一些有3-4排高

那么比如说,

Name1

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

Name2

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 ...

对于区域高度超过一行的实例，我希望通过获取整个列的总和将其折叠为一行

因此，Name2将被复制到新工作簿中，如下所示：

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

我已经编写了一些VBA/VBS，对于区域为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

---

您可以更新代码，使其根据单元格数量独立地添加给定范围（

nm.refrestorange

）中的所有单元格：

Dim irow
irow = 0

'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
            If nm.RefersToRange.Rows.Count >= 1 Then
                wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
                Dim totVal As Long: totVal = 0   'I assumed that target values are Long; update this to the proper type is required
                For Each cell In nm.RefersToRange.Cells
                    If (IsNumeric(cell.Value)) Then totVal = totVal + cell.Value
                Next
                wsDest.Range("A3", wsDest.Cells(3, nm.RefersToRange.Columns.Count + 1)).Offset(irow, 1).Value = totVal
                irow = irow + 1  
            End If  
        End If  
    End if
Next

没有最好的方法，因为每个人都可能认为他们的方法是最好的

我建议使用数组，而不是直接使用范围对象，因为数组会快得多

考虑

现在运行代码

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

导致

---

使用数组的想法来自

您所需要做的就是修改要将数组重新打印到的范围

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

所以如果你使用上面的代码，我想你需要改变的就是

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

---

下面是我结束时使用的代码：它在定义的命名范围的每一列中循环。虽然速度不快，但效果足够好，因为我90%的射程只有一排高

我刚刚在上面的问题中插入了这段代码，

？？…

：

                        For j = 1 To nm.RefersToRange.Columns.Count
                            colsum  = 0
                            For i = 1 To nm.RefersToRange.Rows.Count
                              If IsNumeric(nm.RefersToRange.Cells(i, j).Value) Then                  
                                    colsum = colsum + nm.RefersToRange.Cells(i, j).Value
                              End If                  
                            Next
                            wsDest.Range("A3").Offset(irow, j).Value = colsum
                        Next  

---

是不是每个都将整个区域内的所有单元格折叠为一个单元格？我要查找的输出是一行，其列数与源区域的列数相同。请参阅问题中Name2的第二个版本。@TommyO'Dell此代码与您的代码相同，但将给定范围内的所有行相加；不管数字是多少：1或1000。它将结果值复制到给定的单元格，因此，是的，它将输出您在编辑中显示的内容。嗨，瓦罗，我要查找的是范围内每列的总和，而不是所有单元格的总和。我打算通过我的问题中的一部分来传达这一要求，即名称2将被复制到新的工作簿中，作为。。。结果是一行单元格，如

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

。如果您想将代码更改为将该范围内每列相加的值，我可以将您的答案打勾为正确。@TommyO'Dell您可以自由地将任何答案标记为正确的答案（理想情况下，您认为的答案可以解决您的问题）。但我恐怕您还没有理解我的建议（以及Excel中的范围是如何工作的）：我的For Each cell只是遍历给定范围内的单元格，即nm.referestorange，即给定迭代中的列和所有相关行，其他什么都没有（使用For Each或For与相应的变量之间没有区别）。如果您测试过它或只是问一下，您从一开始就会正确理解这一点。您好，我的工作簿中的几十个工作表中有数千个范围。它们通常在这些区域之间的单元格中包含数据（我不想要的数据），所以任何使用

.End（xlUp）的东西会把它的区域分解成其他数据。对不起，TMMYODE，但是你不清楚，因为你有3个答案，没有一个对你来说是令人满意的。也许你应该考虑更好的解释Needii没有测试你的代码，但是使用数组总是一个更快的选择，因此独立于T。他完全符合OP的要求，这是一个有价值的答案。此外，不喜欢OP沟通不清楚，不理解提议的答案，并提出他们自己的答案，例如，在这种情况下，答案与我的完全相同。尽管如此：+1.嗨，我好，你能解释一下你发现问题的哪些部分不清楚吗？我很乐意回答这是为了提高清晰度。
填写以下问号的最佳方式是什么？
-因此我觉得我的答案为您提供了一个解决方案-您测试过吗？事实上，我意识到我的代码中有一点需要更正（现在它完全适合您的情况）.我想，下一次，当你问一些问题，人们试图帮助你时，你应该打算告诉这些人你想要什么（如果不清楚的话）。实际上，你甚至可能会问，你所尝试的是否是解决问题的最佳方法，我们可能已经提出了一些建议。但是……你可以自由地做任何你想做的事情（虽然下次可能不会有帮助）。我完全同意我的看法。How：您的条件非常不清楚；我已经意识到我的原始版本是正确的（并移回原版）。您只需复制nm.referestorange中的所有单元格（它总是一列宽，可能有一行或多行）；因此，我的代码的原始版本很好：它完全像两个嵌套循环一样遍历给定范围内的所有单元格（请记住，我的For-Each循环将处理任意数量的列）.我在之前的评论中坚持：如果你认为这是帮助他人的正确方式……瓦罗，我很乐意编辑这个问题以使其清晰。你只需提问，并指出哪些部分不清楚。你刚刚（现在和将来的任何问题）明确你的要求，帮助回答问题的人理解为什么他们的答案不符合你的要求；为了做到这一点，你需要理解答案（测试他们或询问回答者）。忍受