Question

我正在编写一个Excel宏，它复制来自1个工作表的信息并将其粘贴到另一个工作表。它必须搜索特定的文本字符串以标识要复制的正确列，并且我使用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

它会逐列1列，看它是否包含特定的搜索词。如果是，则复制它下面的所有内容并从单元L2开始在单独的工作表上粘贴它。它只是一个非常长的宏，我正在努力简化它。 For循环会起作用吗？

Answer 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

最佳变体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

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

我没有任何数据可供测试，但这可能有效（替换您发布的所有代码）：

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 3

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

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

如何简化此VBA切换语句以避免重复这么多代码？

3 个答案: