Question

我正在使用数据，其中唯一的一致性是布局和粗体标题，以区分新的日期。

我试图以粗体显示这些单元格之间的单元格，在所选行中找到值“Individual”（在A列中），然后对D列中给定行的值求和（因为可以有更多然后使用“Individual”1行，并将此新值复制到另一个单元格。由于粗体之间的单元格是一个日期，如果该值不存在，则输出单元格需要向下移动一个而不填充任何内容。以下是我到目前为止的情况：

Sub SelectBetween()

Dim findrow As Long, findrow2 As Long

findrow = range("A:A").Find("test1", range("A1")).Row
findrow2 = range("A:A").Find("test2", range("A" & findrow)).Row
range("A" & findrow + 1 & ":A" & findrow2 - 1).Select

Selection.Find("Individual").Activate

range("D" & (ActiveCell.Row)).Select
Selection.copy
sheets("Mix of Business").Select
range("C4").Select
ActiveSheet.Paste

Exit Sub

errhandler:
MsgBox "No Cells containing specified text found"

End Sub

如何循环遍历数据并且每次循环一个范围时，无论它是否找到值（例如，个人），都会在输出单元格上向下移动一行？另外，如何将findrow更改为格式（粗体）而不是值？

以下是一些供参考的数据：

这就是我想让它看起来像：

Answer 1

因此，您可以很好地开始尝试处理数据。我有一些分享的技巧可以帮助您更接近。（当你通过它时，请回来问更多问题！）

首先，尝试avoid using Select or Activate in your code。当你看一个录制的宏时，我知道你所看到的一切。但这是击键和鼠标点击（选择和激活）的录音。您可以在没有它的单元格或范围内访问数据（请参阅下面的示例）。

为了处理您的数据，您的第一个问题是确定数据集的起始位置（哪一行）以及结束位置。通常，您的数据位于具有 BOLD 数据的单元格之间。例外是最后一个数据集，它只有很多空白行（直到列的末尾）。所以我创建了一个从给定行开始的函数，并检查它下面的每一行，以找到BOLD单元格或数据的结尾。

Private Function EndRowOfDataSet(ByRef ws As Worksheet, _
                                 ByVal startRow As Long, _
                                 Optional maxRowsInDataSet As Long = 50) As Long
    '--- checks each row below the starting row for either a BOLD cell
    '    or, if no BOLD cells are detected, returns the last row of data
    Dim checkCell As Range
    Set checkCell = ws.Cells(startRow, 1)  'assumes column "A"
    Dim i As Long
    For i = startRow To maxRowsInDataSet
        If ws.Cells(startRow, 1).Font.Bold Then
            EndRowOfDataSet = i - 1
            Exit Function
        End If
    Next i
    '--- if we make it here, we haven't found a BOLD cell, so
    '    find the last row of data
    EndRowOfDataSet = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
End Function

为了向您展示如何将其与特定数据一起使用，我创建了一个测试子程序，指示如何遍历所有不同的数据集：

Option Explicit

Public Sub DataBetween()
    Dim thisWB As Workbook
    Dim dataWS As Worksheet
    Set thisWB = ThisWorkbook
    Set dataWS = thisWB.Sheets("YourNameOfSheetWithData")

    '--- find the first bold cell...
    'Dim nextBoldCell As Range
    'Set nextBoldCell = FindNextBoldInColumn(dataWS.Range("A1"))

    '--- now note the start of the data and find the next bold cell
    Dim startOfDataRow As Long
    Dim endOfDataRow As Long
    Dim lastRowOfAllData As Long
    startOfDataRow = 3
    lastRowOfAllData = dataWS.Cells(ws.Rows.Count, "A").End(xlUp).Row

    '--- this loop is for all the data sets...
    Loop
        endOfDataRow = EndRowOfDataSet(dataWS, startOfDataRow)

        '--- this loop is to work through one data set
        For i = startOfDataRow To endOfDataRow
            '--- work through each of the data rows and copy your
            '    data over to the other sheet here
        Next i
        startOfDataRow = endOfDataRow + 1
    Do While endOfDataRow < lastRowOfAllData

End Sub

将这两者结合使用，看看是否可以让您更接近完整的解决方案。

编辑：我应该删除该部分代码。这是我早期的一个概念，并没有完全发挥作用。我评论了这些界限（为了以后清楚地阅读评论）。下面，我将介绍该功能以及为什么它不能完全适用于这种情况。

所以这里有相关的功能：

Public Function FindNextBoldInColumn(ByRef startCell As Range, _
                                     Optional columnNumber As Long = 1) As Range
    '--- beginning at the startCell row, this function check each
    '    lower row in the same column and stops when it encounters
    '    a BOLD font setting
    Dim checkCell As Range
    Set checkCell = startCell
    Do While Not checkCell.Font.Bold
        Set checkCell = checkCell.Offset(1, 0)
        If checkCell.Row = checkCell.Parent.Rows.Count Then
            '--- we've reached the end of the column, so
            '    return nothing
            Set FindNextBoldInColumn = Nothing
            Exit Function
        End If
    Loop
    Set FindNextBoldInColumn = checkCell
End Function

现在，虽然此功能运行良好，但情况并未考虑最后一个数据集的结束。换句话说，就是这样的情况：

在这种情况下，函数FindNextBoldInColumn将返回nothing而不是数据的结尾。所以我（应该已经完全）删除了该函数并将其替换为EndRowOfDataSet，它完全符合您的需要。对不起。

使用循环选择粗体单元格之间的单元格

1 个答案: