如何简化这个VBA switch语句以避免重复太多的代码？

Question

我正在编写一个Excel宏，从一个工作表复制信息并粘贴到另一个工作表中。它必须搜索特定的文本字符串以识别正确的列进行复制，并使用switch语句遍历各个列。它一直到Z，因此宏非常长。我还需要将其用于多个搜索术语，这使得宏太大。

以下是代码摘录：

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

这段代码逐一检查每一列，看是否包含特定的搜索词。如果是，它会将该列下方的所有内容复制并粘贴在另一个工作表中的单元格 L2 开始处。这只是一个非常长的宏，我正在尝试简化它。使用 For 循环可以吗？

- Alex Klinghoffer

---

那不是选择语句的正确使用方式。如果多个条件为真，您是否希望执行多个复制和粘贴操作？ - user4039065

Answer 1

根据我的理解，你实际上正在寻找需要复制数据的标题。如果是这样：

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

- L42

Answer 2

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. Optimal variant imho is Find method

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 looping through the range of cells also optimal I think

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

- Vasily

Answer 3

我没有任何数据可以进行测试，但这可能有效（将您发布的所有代码替换为以下内容）：

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

- Dan Donoghue

Answer 4

试一试这个。函数中的所有操作都相同，除了原始单元格选择之外，因此只需将其作为函数的输入。

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

- Alexander

---

我认为这个函数应该是另一个带有传递范围参数的子函数。避免使用 .Select，使用 .Copy Destination... 是另一种方法。 - user4039065