求助，请求各位大神帮忙，表格合并

[一个小白白]

我想实现它不论第一列有数据或者第二列有数据都能复制并合并过来，但是现在只是在第一列有数据的情况下才能复制合并过来，能帮我看看是哪里出问题了吗，需要怎么修改呢。

Sub 区域合并A()
   Dim ARR, R&, C%, i&, j&, n& '整形可以用%代替，长整形可以用&代替，\\声明变量'
   Sheets(1).Range("A3:F65536").ClearContents '清空第一个表格\\表1.范围A3至F65536范围内表格.清零但不清格式'
    For i = 2 To 10 '遍历2到最后一个表格//从表2到Sheets.Count（总的表格数量）'
        Sheets(i).Activate '激活表格，//从2号开始选择表格'
        'c = Sheets(i).Range("IV1").End(xlToLeft).Column 计算激活表格的列'
        'C = Sheets(i).UsedRange.Columns.Count  '//c=激活表格.使用表格.列.数量'
        C = 10
        'r = Sheets(i).Range("A65536").End(xlUp).Row '计算激活表格的行'
        R = Sheets(i).UsedRange.Rows.Count   '//c=激活表格.使用表格.行.数量'
        If R > 2 Then
        Sheets(i).Range("B3").Resize(R - 2, C).Copy '从第二行开始选中当前表格的所有内容//激活的表格.表格A3.开始的（r-2）行和C列的区域.选中'
       Sheets(1).Range("B65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues '将当前表格所有内容粘贴到汇总表'
        End If
    Next
    Sheets(1).Activate
    'c = Range("IV1").End(xlToLeft).Column 计算激活表格的列'
    C = 10
    R = Range("B65536").End(xlUp).Row '计算激活表格的行
    If R > 2 Then
        ARR = Range("A3").Resize(R - 2, C).Value
        R = UBound(ARR) 'arr的行数'
        C = UBound(ARR, 2) 'arr的列数'
        ReDim BRR(1 To R, 1 To C) '定义和arr相同维数的数组brr'
        For i = 1 To R '遍历第一行到最后一行'
            If ARR(i, 2) <> "" Or ARR(i, 1) <> "" Then
               n = n + 1 '便于将非空行按顺序赋值brr'
               For j = i + 1 To R '将第一行和下面所有行对比'
                   If ARR(i, 2) = ARR(j, 2) And ARR(i, 10) = ARR(j, 10) Then  '相等则将数量相加，同时清空重复项'
                      ARR(i, 6) = ARR(j, 6) + ARR(i, 6)
                      ARR(i, 9) = ARR(j, 9) + ARR(i, 9)
                      ARR(j, 2) = ""
                   End If
               Next j
               For j = 1 To C '将arr的非空项赋值给brr'
                   BRR(n, j) = ARR(i, j)
               Next j
            End If
        Next i
        For i = 1 To n
            BRR(i, 6) = BRR(i, 9)
            BRR(i, 9) = BRR(i, 6) * Range(" I1").Value
        Next i
        Range("B3").Resize(R, C) = "" '清空H1开始的r行c列'
        Range("A3").Resize(R, C) = BRR '将brr赋值给H1开始的r行c列'
    Else
        MsgBox "表格为空"
    End If
End Sub

 

[一个小白白]

@不学完python不改名 非常感谢您帮忙分析，这个我也是自学的并不是我的本行，最近一直在外地现场出差调试，没有及时回复您非常抱歉

[不学完python不改名]

按照您的代码，我构建了一个表格，通过试错发现子表 B列 数据如果为空，则在运行代码时汇总表B列空值所在行会被删除导致无法复制。
按照您问题描述我理解为：B列数据为第1列，C列数据为第2列，

您意图是 如果子表 B列非空 且 C列非空 则将本行数据复制到 表1 中 进行相应计算， 而现在问题是 B列数据为空时，不管C列是否有数据 整行数据都不会被复制。

问题解析： 您的方法中将ARR数组定义为汇总表A列到末列所有数据

ARR = Range("A3").Resize(R - 2, C).Value

而汇总表A列数据在第一行清空代码时全部被删除-即A列数据为空

Sheets(1).Range("A3:F65536").ClearContents '清空第一个表格\表1.范围A3至F65536范围内表格.清零但不清格式'

然后在判定空值时采用

If ARR(i, 2) <> "" Or ARR(i, 1) <> "" Then

此时A列恒定为空，C列数据并未参与判定，即只要 B列 为空，该行判定即成立，导致本行数据被删除

因为问题描述存在歧义，我只能按照本方法推理出错误所在，如非此bug，欢迎将Excel表抹除敏感数据及问题截图打包上传附件，我们可以做进一步探讨