VBA 根据单元格格式查找值并复制连续的行

Question

我目前有以下代码，它将查看 4 个工作表以在 A 列中找到 "Slide1" 的第一个实例。

Dim LastRow1 As Long
Dim i1 As Integer
    For Each ws In Application.ThisWorkbook.Worksheets
        LastRow1 = ws.Cells(Rows.Count, 1).End(xlUp).Row
        i1 = 1

        Do While i1 <= LastRow1
            If ws.Range("A" & i1).Value = "Slide1" Then
                ws.Rows(i1 & ":" & i1 + 2).Copy Sheets("Summary").Range("A105")
            On Error Resume Next
            End If
            i1 = i1 + 1
        Loop
    Next

这工作正常，但有时我需要复制的值包括超过 2 行。

我想包含一些逻辑，通过 a 列中的最后一个单元格设置结束行，该单元格具有特定的 xlEdgeLeft 权重和样式（类似于以下内容）。这是我试图清理的混乱中最独特和最一致的格式。

.Borders(xlEdgeLeft).LineStyle = 1 AND .Borders(xlEdgeLeft).Weight = 4

有人可以帮我解决这个问题吗？我想我需要创建一个新变量来替换 "i1 + 2"，它基本上可以确定 A 列何时停止具有上述 xlEdgeLeft 格式。

Answer 1

我还没有对此进行测试，但是尝试一下我添加到您的代码中的这个 Do-While 循环，您应该能够做到这一点。

Dim copiedRows as Integer
Dim i2 as Integer 
Do While i1 <= LastRow1
    copiedRows = 0
    i2 = i1
    If ws.Range("A" & i1).Value = "Slide1" Then
       Do While ws.Range("A" & i2).Borders(xlEdgeLeft).LineStyle = 1 AND .Borders(xlEdgeLeft).Weight = 4
           copiedRows= copiedRows+1
           i2 = i2 + 1
       Loop
       ws.Rows(i1 & ":" & i1 + copiedRows).Copy Sheets("Summary").Range("A105")
       On Error Resume Next
    End If
    i1 = i1 + 1
Loop

Answer 2

成功了。这是决赛的例子。其中 If ws.Range 找到第一条记录，然后找到从下一行开始的具有指定边框

的所有记录

Dim ws As Excel.Worksheet
Dim LastRow1 As Long
Dim i1 As Integer
Dim i2 As Integer
Dim copiedRows As Integer

For Each ws In Application.ThisWorkbook.Worksheets
LastRow1 = ws.Cells(Rows.Count, 1).End(xlUp).Row
i1 = 1

Do While i1 <= LastRow1
    copiedRows = 0
    i2 = i1
    If ws.Range("A" & i1).Value = "Report" And ws.Range("A" & i1 + 1).Value = "Quarter" Then
       Do While ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).LineStyle = 1 And ws.Range("A" & i2 + 1).Borders(xlEdgeLeft).Weight = 4
            i2 = i2 + 1
           copiedRows = copiedRows + 1
       Loop
       ws.Rows(i1 & ":" & i1 + copiedRows).Copy Sheets("Summary").Range("A1")
       On Error Resume Next
    End If
    i1 = i1 + 1
Loop
Next
End Sub

VBA 根据单元格格式查找值并复制连续的行

VBA Find value and copy consecutive rows based on cell format

excel

vba