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行以上。

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

.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

这就是诀窍。这是决赛的一个例子。如果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根据单元格格式查找值并复制连续的行

2 个答案: