我如何简化这个VBA switch语句来不重复这么多的代码？

我正在写一个Excelmacros从1工作表复制信息并将其粘贴到另一个。 它必须search特定的文本string以确定要复制的右列，并且使用switch语句遍历各个列。 它一直到Z ，所以它是非常长的macros。 我也需要使用这个用于几个search条件，这使得macros太大。

这里是代码的摘录：

 Select Case True Case Range("A1").Value = "SearchTerm1" Sheets("ExportSheet").Select Range("A2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Template").Select Range("L2").Select ActiveSheet.Paste Case Range("B1").Value = "SearchTerm1" Sheets("ExportSheet").Select Range("B2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Template").Select Range("L2").Select ActiveSheet.Paste Case Range("C1").Value = "SearchTerm1" Sheets("ExportSheet").Select Range("C2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Template").Select Range("L2").Select ActiveSheet.Paste Case Range("D1").Value = "SearchTerm1" Sheets("ExportSheet").Select Range("D2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Template").Select Range("L2").Select ActiveSheet.Paste Case Range("E1").Value = "SearchTerm1" Sheets("ExportSheet").Select Range("E2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Template").Select Range("L2").Select ActiveSheet.Paste 

它将逐个查看列是否包含特定的search词。 如果是这样，它将复制它下面的所有内容，并将其从单元格L2开始粘贴到单独的工作表上。 这只是一个非常长的macros，我试图简化它。 For循环是否工作？

Answer 1

1. 如果你喜欢这种方法，你的变体已经更新

 With Sheets("ExportSheet") Select Case True Case .[A1].Value = "SearchTerm1" .Range("A2:A" & Cells(.Rows.Count, "A").End(xlUp).Row).Copy Sheets("Template").[L2] Case .[B1].Value = "SearchTerm1" .Range("B2:B" & Cells(.Rows.Count, "B").End(xlUp).Row).Copy Sheets("Template").[L2] Case .[C1].Value = "SearchTerm1" .Range("C2:C" & Cells(.Rows.Count, "C").End(xlUp).Row).Copy Sheets("Template").[L2] ' and so on End Select End With End Sub 

2. 最佳变体imho是Find方法

 Sub test2() Dim x&, y& On Error GoTo errorhandler With Sheets("ExportSheet") y = .Rows(1).Find("SearchTerm1").Column x = .Cells(Rows.Count, y).End(xlUp).Row .Range(.Cells(2, y), .Cells(x, y)).Copy Sheets("Template").[L2] End With Exit Sub errorhandler: MsgBox "There is no 'SearchTerm1' in 'ExportSheet'!" End Sub 

3. For each循环的细胞范围也是最佳的我想

 Sub test3() Dim Cl As Range For Each Cl In Sheets("ExportSheet").[A1:E1] If Cl.Value = "SearchTerm1" Then Sheets("ExportSheet").Range(Cl.Offset(1, 0).Address(0, 0), _ Cells(Rows.Count, Cl.Column).End(xlUp).Address(0, 0)).Copy _ Sheets("Template").[L2] Exit For End If Next End Sub 

Answer 2

据我了解，你实际上是在寻找你需要复制数据的头。 如果是这样的话：

 With Sheets("ExportSheet") Dim r As Range: Set r = .Range("1:1").Find("SearchTerm1") If Not r Is Nothing Then .Range(r.Offset(1, 0), r.Offset(1, 0).End(xlDown)).Copy _ Sheets("Template").Range("L2") End If End With 

Answer 3

我没有任何数据可以testing，但是这可能会起作用（用您所发布的所有代码replace）：

 Dim X As Long For X = 0 To 4 If Range("A1").Offset(0, X).Value = "SearchTerm1" Then Sheets("ExportSheet").Range("A2").Offset(0, X).Resize(Sheets("ExportSheet").Range("A2").Offset(0, X).End(xlDown).Row - 2, 1).Copy Sheets("Template").Range("L2").PasteSpecial xlPasteAll Exit For End If Next 

Answer 4

试试这个。 除了要select的原始单元格之外，该函数中的所有操作都是相同的，因此只需将其作为函数的input即可。

 Function copy_data(cell) Sheets("ExportSheet").Select Range(cell).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Template").Select Range("L2").Select ActiveSheet.Paste End Function Select Case True Case Range("A1").Value = "SearchTerm1" copy_data("A2") Case Range("B1").Value = "SearchTerm1" copy_data("B2") Case Range("C1").Value = "SearchTerm1" copy_data("C2") Case Range("D1").Value = "SearchTerm1" copy_data("D2") Case Range("E1").Value = "SearchTerm1" copy_data("E2") End Select