VBA Union合并范围不全及Range方法1004错误求助
Excel VBA中合并大型Range时的Union方法异常及Range创建报错问题
环境:Office 365 Excel 2405(内部版本17628.20188)
异常现象
- 合并两个小型Range(各含3个区域)时,Union方法可正常合并所有6个区域;
- 合并目标大型Range时,Union结果仅将第二个Range的第一个区域追加到第一个Range后,无报错;
- 减少第一个Range的一个区域后,Union结果可追加第二个Range的前两个区域;
- 直接创建包含所有目标区域的Range时,触发“Run-time error '1004': Method 'Range' of object '_Global' failed”错误。
测试代码
Sub Foo() Dim ws As Worksheet Set ws = Worksheets("DATA") ws.Activate Dim R11, R12, R13, R21, R22, R23, R31, R32, R33, R41 As Range Set R11 = ws.Range("$B$49:$C$49,$C$50:$C$53,$B$54:$C$54") Set R12 = ws.Range("$A$55:$C$55,$C$56:$C$59,$B$60:$C$60") Set R13 = Union(R11, R12) MsgBox "R11: " & vbNewLine & R11.Address MsgBox "R12: " & vbNewLine & R12.Address MsgBox "R13: " & vbNewLine & R13.Address Set R21 = ws.Range("$A$4:$C$4,$C$5:$C$8,$B$9:$C$9,$C$10:$C$13,$B$14:$C$14,$C$15:$C$18,$B$19:$C$19,$C$20:$C$23, _ $B$24:$C$24,$C$25:$C$28,$B$29:$C$29,$C$30:$C$33,$B$34:$C$34,$C$35:$C$38,$B$39:$C$39,$C$40:$C$43, _ $B$44:$C$44,$C$45:$C$48,$B$49:$C$49,$C$50:$C$53,$B$54:$C$54") Set R22 = ws.Range("$A$55:$C$55,$C$56:$C$59,$B$60:$C$60,$C$61:$C$64,$B$65:$C$65,$C$66:$C$69,$B$70:$C$70,$C$71:$C$74, _ $B$75:$C$75,$C$76:$C$79,$B$80:$C$80,$C$81:$C$84,$B$85:$C$85,$C$86:$C$89,$B$90:$C$90,$C$91:$C$94, _ $B$95:$C$95,$C$96:$C$99,$B$100:$C$100,$C$101:$C$104") Set R23 = Union(R21, R22) MsgBox "R21: " & vbNewLine & R21.Address MsgBox "R22: " & vbNewLine & R22.Address MsgBox "R23: " & vbNewLine & R23.Address Set R31 = ws.Range("$A$4:$C$4,$C$5:$C$8,$B$9:$C$9,$C$10:$C$13,$B$14:$C$14,$C$15:$C$18,$B$19:$C$19,$C$20:$C$23, _ $B$24:$C$24,$C$25:$C$28,$B$29:$C$29,$C$30:$C$33,$B$34:$C$34,$C$35:$C$38,$B$39:$C$39,$C$40:$C$43,$B$44:$C$44, _ $C$45:$C$48,$B$49:$C$49,$C$50:$C$53") Set R32 = ws.Range("$A$55:$C$55,$C$56:$C$59,$B$60:$C$60,$C$61:$C$64,$B$65:$C$65,$C$66:$C$69,$B$70:$C$70,$C$71:$C$74, _ $B$75:$C$75,$C$76:$C$79,$B$80:$C$80,$C$81:$C$84,$B$85:$C$85,$C$86:$C$89,$B$90:$C$90,$C$91:$C$94,$B$95:$C$95, _ $C$96:$C$99,$B$100:$C$100,$C$101:$C$104") Set R33 = Union(R31, R32) MsgBox "R31: " & vbNewLine & R31.Address MsgBox "R32: " & vbNewLine & R32.Address MsgBox "R33: " & vbNewLine & R33.Address Set R41 = ws.Range("$A$4:$C$4,$C$5:$C$8,$B$9:$C$9,$C$10:$C$13,$B$14:$C$14,$C$15:$C$18,$B$19:$C$19,$C$20:$C$23, _ $B$24:$C$24,$C$25:$C$28,$B$29:$C$29,$C$30:$C$33,$B$34:$C$34,$C$35:$C$38,$B$39:$C$39,$C$40:$C$43, _ $B$44:$C$44,$C$45:$C$48,$B$49:$C$49,$C$50:$C$53,$B$54:$C$54,$A$55:$C$55,$C$56:$C$59,$B$60:$C$60, _ $C$61:$C$64,$B$65:$C$65,$C$66:$C$69,$B$70:$C$70,$C$71:$C$74,$B$75:$C$75,$C$76:$C$79,$B$80:$C$80, _ $C$81:$C$84,$B$85:$C$85,$C$86:$C$89,$B$90:$C$90,$C$91:$C$94,$B$95:$C$95,$C$96:$C$99,$B$100:$C$100, _ $C$101:$C$104") End Sub
解决方案
1. 循环逐个合并区域,规避数量限制
Excel VBA的Union方法和直接通过逗号创建Range时,存在32个独立区域的上限,超过后会出现截断或报错。解决办法是遍历所有需要合并的区域,逐个执行Union操作:
Sub MergeLargeRanges() Dim ws As Worksheet Set ws = Worksheets("DATA") ' 定义所有需要合并的地址数组 Dim addrArray As Variant addrArray = Array( _ "$A$4:$C$4", "$C$5:$C$8", "$B$9:$C$9", "$C$10:$C$13", _ "$B$14:$C$14", "$C$15:$C$18", "$B$19:$C$19", "$C$20:$C$23", _ "$B$24:$C$24", "$C$25:$C$28", "$B$29:$C$29", "$C$30:$C$33", _ "$B$34:$C$34", "$C$35:$C$38", "$B$39:$C$39", "$C$40:$C$43", _ "$B$44:$C$44", "$C$45:$C$48", "$B$49:$C$49", "$C$50:$C$53", _ "$B$54:$C$54", "$A$55:$C$55", "$C$56:$C$59", "$B$60:$C$60", _ "$C$61:$C$64", "$B$65:$C$65", "$C$66:$C$69", "$B$70:$C$70", _ "$C$71:$C$74", "$B$75:$C$75", "$C$76:$C$79", "$B$80:$C$80", _ "$C$81:$C$84", "$B$85:$C$85", "$C$86:$C$89", "$B$90:$C$90", _ "$C$91:$C$94", "$B$95:$C$95", "$C$96:$C$99", "$B$100:$C$100", _ "$C$101:$C$104" _ ) Dim mergedRange As Range Dim addr As Variant For Each addr In addrArray If mergedRange Is Nothing Then Set mergedRange = ws.Range(addr) Else Set mergedRange = Union(mergedRange, ws.Range(addr)) End If Next addr ' 验证结果 MsgBox "合并后的区域地址:" & vbNewLine & mergedRange.Address End Sub
2. 合并相邻区域减少总数
如果部分区域是相邻或连续的,先将它们合并为单个区域,降低总区域数量后再执行Union操作。比如将连续的单元格范围合并成一个地址,减少需要处理的独立区域数。
3. 更新Excel版本
特定内部版本的Excel可能存在Range处理的bug,尝试将Office更新到最新版本,或修复安装,排除版本问题导致的异常。
内容的提问来源于stack exchange,提问作者Taz Mania
相关产品推荐
相关产品推荐

