Question

我正在尝试汇总自动生成的数据并将其放入此类格式。

我在那里添加了红色单元格，以便它们可以帮助我设置从工作表中提取数据所需的范围。目标是设置从具有数字的单元格到下一个红色单元格的范围（如图中的数字3为框架）。到目前为止，我已经将范围一直放到顶部单元格，但这导致了数据传输的许多错误。代码如下：

 For Each C In copyRng
        Set colSrc = C.EntireRow.Offset(0).Cells(1)
        If IsNumeric(C) And C.Value <> "0" And Len(C) <> 0 And C.Value < 2010 And InStr(1, colSrc, "Total") = 0 Then
            Set rowRange = xSheet.Range(C, C.EntireColumn.Cells(1))

            For Each q In rowRange
                If InStr(1, q.Value, "C-") Then
                    Set rowSrc = q
                    Set colSrc = C.EntireRow.Offset(0).Cells(1)
                    Set yearSrc = q.EntireRow.Offset(-1).Cells(3)
                    Set qtrSrc = q.EntireRow.Offset(-1).Cells(2)
                    Set exchSrc = q.EntireRow.Offset(-1).Cells(1)
                End If
            Next q

是否可以设置这样的范围，或者我应该尝试寻找其他方法。最终目标是找出以C-开头的帐号，在数字上方，并忽略任何在其上方有“总计”的数字。

Answer 1

我想出了另一种方式。我不是按颜色设置范围，而是设置2个范围，并使用第一个设置适当大小的第二个范围。代码看起来像这样。如果我的第一个想法可能，我会非常感兴趣。

    For Each C In copyRng
        Set colSrc = C.EntireRow.Offset(0).Cells(1)
        If IsNumeric(C) And C.Value <> "0" And Len(C) <> 0 And C.Value < 2010 And InStr(1, colSrc, "Total") = 0 Then
            Set SetRange = xSheet.Range(C, C.EntireColumn.Cells(1))
            For Each k In SetRange
                If InStr(1, k.Value, "C-") Or InStr(1, k.Value, "Total") Then Set setSource = k
            Next k

            Set rowRange = xSheet.Range(C, setSource)
            For Each q In rowRange
                If InStr(1, q.Value, "C-") Then
                    Set rowSrc = q
                    Set colSrc = C.EntireRow.Offset(0).Cells(1)
                    Set yearSrc = q.EntireRow.Offset(-1).Cells(3)
                    Set qtrSrc = q.EntireRow.Offset(-1).Cells(2)
                    Set exchSrc = q.EntireRow.Offset(-1).Cells(1)

                    numCol = DestSh.Cells.Find(colSrc.Value, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
                    For Each u In DestSh.Range("A1:A548")
                        If rowSrc = u And yearSrc = u.Offset(0, 2) And exchSrc = u.Offset(0, 1) And qtrSrc = u.Offset(0, 3) Then numRow = u.Row
                    Next u

                    C.Interior.ColorIndex = 4
                    Set destRng = DestSh.Cells(numRow, numCol)
                    C.Copy destRng

                ElseIf InStr(1, q.Value, "Total") Then Exit For
                End If

            Next q

根据单元格颜色/ VBA设置动态范围

1 个答案: