Как использовать больший цикл, чтобы завершить несколько задач вместо 14 циклов?

Question

Необходим поиск в 14 столбцах и копирование этих 14 столбцов в другое место назначения из Excel с более чем 100 столбцами в нем.

Я успешно выполнил эту задачу, используя 14 циклов "For". Интересно, есть ли какие-либо решения для выполнения этой задачи с использованием большого цикла вместо 14 маленьких циклов ?

Было бы очень полезно, если бы кто-нибудь мог показать мне, как это сделать. Большое спасибо!

Если объединение 14 циклов слишком скучно для вас, попробуйте показать мне, объединяя 3 маленьких цикла, вместо этого также полезно. Спасибо!

' Search for "Project Code CSO"
For Each Rng In Range("a1:fi1")
    If Rng = "Project Code CSO" Then
        f_1 = Rng.Column
    End If
Next
Columns(f_1).Copy Destination:=Sheets(7).Columns("A")

' Search for "Code"
For Each Rng In Range("a1:fi1")
    If Rng = "Code" Then
        f_2 = Rng.Column
    End If
Next
Columns(f_2).Copy Destination:=Sheets(7).Columns("B")

' Search for "Study Desc"
For Each Rng In Range("a1:fi1")
    If Rng = "Study Desc" Then
        f_3 = Rng.Column
    End If
Next
Columns(f_3).Copy Destination:=Sheets(7).Columns("C")

' Search for "Study Phase"
For Each Rng In Range("a1:fi1")
    If Rng = "Study Phase" Then
        f_4 = Rng.Column
    End If
Next
Columns(f_4).Copy Destination:=Sheets(7).Columns("D")

' Search for "Regions/countries List"
For Each Rng In Range("a1:fi1")
    If Rng = "Regions/countries List" Then
        f_5 = Rng.Column
    End If
Next
Columns(f_5).Copy Destination:=Sheets(7).Columns("E")

' Search for "? RTM Study"
For Each Rng In Range("a1:fi1")
    If Rng = "? RTM Study" Then
        f_6 = Rng.Column
    End If
Next
Columns(f_6).Copy Destination:=Sheets(7).Columns("F")

' Search for "Cent."
For Each Rng In Range("a1:fi1")
    If Rng = "Cent." Then
        f_7 = Rng.Column
    End If
Next
Columns(f_7).Copy Destination:=Sheets(7).Columns("G")

' Search for "Pat."
For Each Rng In Range("a1:fi1")
    If Rng = "Pat." Then
        f_8 = Rng.Column
    End If
Next
Columns(f_8).Copy Destination:=Sheets(7).Columns("H")

' Search for "Pat/Cent"
For Each Rng In Range("a1:fi1")
    If Rng = "Pat/Cent" Then
        f_9 = Rng.Column
    End If
Next
Columns(f_9).Copy Destination:=Sheets(7).Columns("I")

' Search for "FPI Planned Start"
For Each Rng In Range("a1:fi1")
    If Rng = "FPI Planned Start" Then
        f_10 = Rng.Column
    End If
Next
Columns(f_10).Copy Destination:=Sheets(7).Columns("J")

' Search for "LPI/LSI planned Date"
For Each Rng In Range("a1:fi1")
    If Rng = "LPI/LSI planned Date" Then
        f_11 = Rng.Column
    End If
Next
Columns(f_11).Copy Destination:=Sheets(7).Columns("K")

' Search for "LPLV/LSLV planned start date"
For Each Rng In Range("a1:fi1")
    If Rng = "LPLV/LSLV planned start date" Then
        f_12 = Rng.Column
    End If
Next
Columns(f_12).Copy Destination:=Sheets(7).Columns("L")

' Search for "DBL-FPI"
For Each Rng In Range("a1:fi1")
    If Rng = "DBL-FPI" Then
        f_13 = Rng.Column
    End If
Next
Columns(f_13).Copy Destination:=Sheets(7).Columns("M")


' Search for "DBL planned start"
For Each Rng In Range("a1:fi1")
    If Rng = "DBL planned start" Then
        f_14 = Rng.Column
    End If
Next
Columns(f_14).Copy Destination:=Sheets(7).Columns("N")

Sheets(7).Select

Я новичок в 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