是否有VBA /宏代码用于在工作表中使用粗体文本查找和选择第一个单元格？

Question

我收到了一位供应商的工作报告。 该报告实际上是一系列报告，它们都是垂直放入Excel的不同格式。 我要做的是将每个报告解析成一个单独的选项卡并清理多余的行/列，因为在当前格式中它真的很难看。

我已经发现了一些碎片，我拼凑起来删除多余的行和列，一旦我将数据放在单独的选项卡上，但我正在努力解决的部分是将每个报告解析为它自己的选项卡。 下面是我尝试过的，它适用于具有相同标题的报表，但是当您在整个报表中获得部分时，标题会发生变化。 这个工作表上每个报告的唯一共同点就是报告的标题是粗体文字，然后下面的所有内容，直到下一个报告开始，都不是粗体。 有没有办法编辑下面的内容，以便它找到的范围从带有粗体文本的第一行到带有粗体文本的下一行，少一个？

Dim findrow As Long, findrow2 As Long
findrow = Range("A:A").Find("Employee Updates", Range("A1")).Row
findrow2 = Range("A:A").Find("Employee Updates", Range("A" & 
findrow)).Row
Range("A" & findrow & ":BG" & findrow2 - 1).Select
'selects rows between employee updates header'

Selection.Cut 'cuts and pastes to a new tab'
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste[enter image description here][1]

Answer 1

首先，不要在代码上使用“选择”。 这是一种不好的做法，可以给你很多不同的问题。

我会建议你：

   Dim initialRow As Long, endRow As Long
   'starts on line 1 and goes on
   initialRow = 1
   'checks for bold in column 1
   Do While Cells(initialRow,1).Font.Bold = False
     initialRow = initialRow + 1
   Loop
   endRow = initialRow+1
   Do While Cells(endRow+1,1).Font.Bold = False
     endRow = endRowRow + 1
   Loop
   Range("A" & initialRow & ":BG" & endRow).Cut
   Sheets.Add After:=ActiveSheet
   ActiveSheet.Paste

这将为您提供一个粗体和下一个之间的区域，假设它们位于第一列，否则您可能需要更改它。 请注意，这将需要进行调整，以防您循环遍历所有单元格，特别是为了避免上一个报告中的错误，其中没有任何粗体单元格告诉程序停止查找它们