时间戳

首页 > 解决方案 > 在以单元格值为条件的字符串之间复制内容

excel - 在以单元格值为条件的字符串之间复制内容

问题描述

我对 VBA 非常陌生，并且一直负责编写宏。

我有一个系统生成的文件，看起来像这样
起始文件

我最终应该得到三个看起来像这样的工作表

结束文件 1
结束文件 1

结束文件 2
结束文件 2

结束文件 3
结束文件 3

也就是说，我试图找到一种方法来复制“项目 1”和“项目 2”、“项目 2”和“项目 3”等之间的行，在所有情况下，列 D、E 或 F 中的单元格是不是空的。

通过浏览论坛，我可以找到一些让我开始的东西，但我不知道如何继续。任何帮助，将不胜感激。谢谢。

Sub CopyRows()
    Dim r As Range, fr As String    'Item1
    Dim c As Range, fc As String    'Item2
    Dim StartR As Integer
    Dim EndR As Integer
    Dim NwRng As Range, Nwc As Range
    Dim nwSh As Worksheet
    
    fr = "Item 1"
    fc = "Item 2"

    Set r = Range("A:A").Find(what:=fr, lookat:=xlWhole)
    Set c = Range("A:A").Find(what:=fc, lookat:=xlWhole)

    If Not r Is Nothing Then
        StartR = r.Row + 1
    Else: MsgBox fr & " not found"
        Exit Sub
    End If

    If Not c Is Nothing Then
        EndR = c.Row - 1
    Else: MsgBox fc & " not found"
        Exit Sub
    End If

    Set NwRng = Range("D" & StartR & ":D" & EndR)
    Set nwSh = Sheets.Add

    For Each Nwc In NwRng.Cells
        If Not IsEmpty(Nwc) Then Nwc.EntireRow.Copy nwSh.Cells(nwSh.Rows.Count, "A").End(xlUp).Offset(1)
    Next Nwc
    

End Sub

标签： excelvba

解决方案

实际上，您可以在不循环的情况下仅使用自动过滤器来做到这一点。所有你需要的是：

  1. 使用自动过滤器

  2. 过滤Description非空白和Set1非空白并复制它。

  3. 过滤Description非空白和Set2非空白并复制它。

  4. 过滤Description非空白和Set3非空白并复制它。

  5. 完毕。

没有搜索，没有循环，没有混乱。最后你唯一需要做的就是清理你不喜欢的列。

推荐阅读