Question

有必要搜索14列，并从其中包含100多个列的Excel中将这14列复制到另一个目标。

我已经通过使用14个“ For”循环成功完成了此任务。我想知道是否有解决方案可以通过使用大循环而不是14个小循环来完成此任务？

如果有人可以告诉我如何做到这一点，将非常有帮助。非常感谢你！

如果合并14个循环对您来说太无聊，请尝试通过合并3个小循环向我展示，这也很有帮助。谢谢！

JPAEntityManager

我是VBA的新手，我希望知道如何通过使用单个大循环将那些小循环合并在一起。：-）

Answer 1

下面应该这样做。您需要添加其他情况，我只给出了3个示例：

Option Explicit

Public Sub CopyColumns()
    Dim Col As String

    Dim Rng As Range
    For Each Rng In Range("A1:FI1")

        Select Case Rng.Value
            Case "Project Code CSO":    Col = "A"
            Case "Code":                Col = "B"
            Case "Study Desc":          Col = "C"

            'put your other cases here

            Case Else: Col = vbNullString
        End Select

        If Col <> vbNullString Then
            Rng.EntireColumn.Copy Destination:=Sheets(7).Columns(Col)
        End If
    Next Rng
End Sub

Answer 2

您的重复代码已连续14次重复。这很好地表明了此代码属于循环（会使整个结构成为嵌套循环）。像这样：

Sub test()
    Dim Rng As arange
    Dim criteria As Variant, targets As Variant
    Dim i As Long, f_1 As Long

    criteria = Array("Project Code CSO", "Code", "Study Desc", "Study Phase", "Regions/countries List", _
                     "? RTM Study", "Cent.", "Pat.", "Pat/Cent", "FPI Planned Start", _
                     "LPI/LSI planned Date", "LPLV/LSLV planned start date", _
                     "DBL-FPI", "DBL planned start")

    targets = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")

    For i = 0 To 13
        f_1 = 0
        For Each Rng In Range("a1:fi1")
            If Rng = criteria(i) Then
                f_1 = Rng.Column
            End If
        Next
        'In practice, you shouldn't assume you found what you seek, but optimistically:
        Columns(f_1).Copy Destination:=Sheets(7).Columns(targets(i))
    Next i

End Sub

如何使用更大的循环而不是14个循环来完成多个任务？

2 个答案: