在公式中使用时，Range.Address被截断（字符串太长）

Question

我有循环遍历用户选择范围的第5列的代码，并且如果第5列中的当前单元格符合条件，则将同一行中的下10个单元格添加到范围中。最后，如果它为空，它将对单元格A1中的最终范围求和。

Sub SumItems()
   Dim selectedRange As Range
   Set selectedRange = Selection

   Dim sumRange As Range
   Dim i As Long
   For i = 1 To selectedRange.Rows.Count
      If selectedRange(i, 5) = "Yes" Then
         If sumRange Is Nothing Then
            Set sumRange = Range(selectedRange(i, 5).Offset(0, 1), selectedRange(i, 5).Offset(0, 10))
         Else
            Set sumRange = Union(sumRange, Range(selectedRange(i, 5).Offset(0, 1), selectedRange(i, 5).Offset(0, 10)))
         End If
      End If
   Next i

   If Not sumRange Is Nothing Then
      If IsEmpty(Range("A1")) Then
         Range("A1").Formula = "=SUM(" + sumRange.Address(False, False) + ")"
      Else
         MsgBox "Cannot paste in cell A1, it is not empty."
         Exit Sub
      End If
   Else
      MsgBox "No matching rows were found."
      Exit Sub
   End If
End Sub

我正在运行的工作表很长。因此，sumRange通常将是工作表中许多不同区域的并集。我注意到，一旦sumRange.Areas.Count超过18，Range（“ A1”）。Formula语句就会出现问题。 sumRange.Address（False，False）字符串在第18个区域之后被截断。我相信这是因为.Address字符串的长度太长，仅与此工作表的18个区域重合。

我开发了一个临时解决方案，但它限制了子例程可以处理的区域数量，并且笨拙且冗长。我设置了临时范围变量，以将sumRange分成超过18个区域，并且IF语句现在显示为：

If Not sumRange Is Nothing Then
   If IsEmpty(Range("A1")) Then
      If sumRange.Areas.Count > 18 Then
         Dim k As Long
         Dim tmpSumRange1 As Range
         Dim tmpSumRange2 As Range
         Dim tmpSumRange3 As Range
         ' And so on...
         For k = 1 To sumRange.Areas.Count
            If k <= 18 Then
               If tmpSumRange1 Is Nothing Then
                  Set tmpSumRange1 = sumRange.Areas(k)
               Else
                  Set tmpSumRange1 = Union(tmpSumRange1, sumRange.Areas(k))
               End If
            ElseIf k > 18 And k <= 36 Then
               If tmpSumRange2 Is Nothing Then
                  Set tmpSumRange2 = sumRange.Areas(k)
               Else
                  Set tmpSumRange2 = Union(tmpSumRange2, sumRange.Areas(k))
               End If
            ElseIf k > 36 And k <= 54 Then
               If tmpSumRange3 Is Nothing Then
                  Set tmpSumRange3 = sumRange.Areas(k)
               Else
                  Set tmpSumRange3 = Union(tmpSumRange3, sumRange.Areas(k))
               End If

            ElseIf
               ' And so on until I get to k = 180...
            End If
         Next k

         If Not tmpSumRange1 Is Nothing And tmpSumRange2 Is Nothing And tmpSumRange3 Is Nothing Then
            Range("A1").Formula = "=SUM(" + tmpSumRange1.Address(False, False) + ")"
         ElseIf Not tmpSumRange1 Is Nothing And Not tmpSumRange2 Is Nothing And tmpSumRange3 Is Nothing Then
            Range("A1").Formula = "=SUM(" + tmpSumRange1.Address(False, False) + "," + tmpSumRange2.Address(False, False) + ")"
         ElseIf Not tmpSumRange1 Is Nothing And tmpSumRange2 Is Nothing And Not tmpSumRange3 Is Nothing Then
            Range("A1").Formula = "=SUM(" + tmpSumRange1.Address(False, False) + "," + tmpSumRange2.Address(False, False) + "," + tmpSumRange3.Address(False, False) + ")"
         ElseIf
            ' And so on all the way up to tmpSumRange10...
         End If
      Else
         Range("A1").Formula = "=SUM(" + sumRange.Address(False, False) + ")"
      End If
   Else
      MsgBox "Cannot paste in cell A1, it is not empty."
      Exit Sub
   End If
Else
   MsgBox "No matching rows were found."
   Exit Sub
End If

我知道必须有一个比这更好的解决方案。在搜索中没有发现任何东西。我也没有找到遇到过相同问题的任何人。我需要A1单元格具有SUM公式及其范围，否则我将对子例程中的值求和并插入该值而不是公式。

Answer 1

所以有两个单独的但可能相关的问题：

• { "name": "WebApplication1", "private": true, "version": "0.0.0", "scripts": { "test": "karma start ClientApp/test/karma.conf.js" }, "devDependencies": { "@angular/animations": "6.1.3", "@angular/common": "6.1.3", "@angular/compiler": "6.1.3", "@angular/compiler-cli": "^6.1.3", "@angular/core": "6.1.3", "@angular/forms": "6.1.3", "@angular/http": "6.1.3", "@angular/platform-browser": "6.1.3", "@angular/platform-browser-dynamic": "6.1.3", "@angular/platform-server": "6.1.3", "@angular/router": "6.1.3", "@ngtools/webpack": "1.5.0", "@types/chai": "4.0.1", "@types/jasmine": "2.5.53", "@types/webpack-env": "1.13.0", "aspnet-prerendering": "^3.0.1", "aspnet-webpack": "^2.0.3", "awesome-typescript-loader": "3.2.1", "bootstrap": "^4.1.3", "chai": "4.0.2", "css": "2.2.1", "css-loader": "0.28.4", "es6-shim": "0.35.3", "event-source-polyfill": "0.0.9", "expose-loader": "0.7.3", "extract-text-webpack-plugin": "2.1.2", "file-loader": "0.11.2", "html-loader": "0.4.5", "isomorphic-fetch": "2.2.1", "jasmine-core": "2.6.4", "jquery": "3.2.1", "json-loader": "0.5.4", "karma": "1.7.0", "karma-chai": "0.1.0", "karma-chrome-launcher": "2.2.0", "karma-cli": "1.0.1", "karma-jasmine": "1.1.0", "karma-webpack": "2.0.3", "preboot": "4.5.2", "raw-loader": "0.5.1", "reflect-metadata": "0.1.10", "rxjs": "6.2.2", "style-loader": "0.18.2", "to-string-loader": "1.1.5", "typescript": "2.9.2", "url-loader": "0.5.9", "webpack": "2.5.1", "webpack-hot-middleware": "2.18.2", "webpack-merge": "4.1.0", "zone.js": "0.8.26" }, "dependencies": { "@angular/cli": "^6.1.4", "popper.js": "^1.14.4", "rxjs-compat": "^6.0.0-rc.0" } } 最多截断255个字符，没有错误。这很奇怪，因为Excel足够聪明，不会给您留下会加1004的部分地址字符串，但同时它也很愚蠢，足以截断Range.Address，这显然会产生意想不到的结果用于公式等
• 如果将字符串传递给Address（请参阅this old thread）进行讨论，则Excel函数的字符串参数存在大约255个字符的限制，但是我在下面摘录了相关的内容）。 / li>

  

Excel函数参数将接受引用，该字符串的长度最多为32767（可能的总长度为32k或2 ^ 15）。 ...但是如果我们传递一个值而不是一个引用怎么办？

     

我们最多可以将 reference 传递给字符串，最大32k，我们只能传递 value 字符串，最多255

问题似乎出在ByVal长度上，但这是一条红色鲱鱼。

您肯定遇到Formula的截断问题。

问题：Range.Address被截断为255个字符

由于这是默默发生的情况，因此您基于截断地址构建的任何公式都将受到不利影响；结果将达不到您的期望，因为该公式不能代表范围的所有部分！

如果您想解决此问题，我已经将此记录为Microsoft的错误：

https://github.com/MicrosoftDocs/VBA-Docs/issues/49

同时，幸运的是，该解决方案非常简单（尽管得出来并不简单！），看看是否可以适应您的目的，但想法是：

1. 创建一个Range.Address，我们将所有单独的System.Collections.ArrayList地址存储到其中（或者，您可以使用Area，但是与Variant等相比，它们有些笨拙。 ）
2. 使用ReDim方法将ArrayList转换为变量数组
3. 在您的ToArray()字符串中使用Join函数的结果

---

Formula

您会在工作表中看到超长公式（Sub example() Dim myNames As Object Dim formula as String Dim k As Long Dim sumRange As Range Dim thisArea As Range ' Example: ' -- creates a range consisting of 100 Areas ' -- this .Address will truncate to 252 characters! For k = 1 To 200 Step 2 Set thisArea = Range("A" & k) If sumRange Is Nothing Then Set sumRange = thisArea Set sumRange = Union(sumRange, thisArea) Next ' Iterate the sumRange union and add each Area to an ArrayList Set myNames = CreateObject("System.Collections.ArrayList") For Each thisArea In sumRange.Areas myNames.Add thisArea.Address Next ' Output to worksheet: Dim outputCell As Range Set outputCell = Range("F1") formula = "=Sum(" & Join(myNames.ToArray(), ",") & ")" outputCell.Formula = formula End Sub == 650）：

如果您不习惯使用Len，则可以将其强制为`String：

ArrayList