Question

我在代码下运行。名为＆＃34; fast＆＃34;的工作表包含循环，运行，步行，慢跑等名称。代码当前搜索单词＆＃34;循环＆＃34;在特定的行中，如果找到它，则复制整个列并将其粘贴到名为＆＃34; cycle＆＃34;的工作表中。目前我正在重复脚本并更改＆＃34; Cycle＆＃34;对于像＆＃34; run＆＃34;这样的名字＆＃34;步行＆＃34;我是否可以通过反复重复相同的脚本来缩短和提高效率。

Sub Cycle()

Dim C As Range
Dim col As Long, lastCol As Long

With Worksheets("fast")
    lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    col = 1
    For Each C In .Range(.Cells(2, 1), .Cells(2, lastCol))
        If C.value = "Cycle" Then
            C.EntireColumn.Copy Destination:=Sheets("Cycle").Columns(col)
            C.EntireColumn.Copy
            Sheets("Cycle").Columns(col).PasteSpecial xlPasteValues
            col = col + 1
        End If
    Next C
End With
Worksheets("Cycle").Activate

End Sub

Answer 1

请尝试以下代码，如果这就是您的意思，请告诉我们：

Option Explicit

Sub Cycle()

Dim C               As Range
Dim StringsArr      As Variant
Dim col As Long, lastCol As Long

StringsArr = Array("cycle", "run", "walk", "jog")

With Worksheets("fast")
    lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    For Each C In .Range(.Cells(2, 1), .Cells(2, lastCol))
        ' check per cell if value is one of the values in StringsArr array
        If Not IsError(Application.Match(C.value, StringsArr, 0)) Then
            col = Sheets(C.value).Cells(2, Sheets(C.value).Columns.Count).End(xlToLeft).Column + 1 ' find first empty column in relevant sheet
            C.EntireColumn.Copy
            Sheets(C.value).Columns(col).PasteSpecial xlPasteValues
        End If
    Next C
End With

End Sub

包含不同工作表名称的循环代码

1 个答案: