如何简化此 VBA switch 语句以不重复这么多代码?
How do I simplify this VBA switch statement to not repeat so much code?
我正在编写一个 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 乘 1 地浏览各列以查看它是否包含特定的搜索词。如果是,它会复制其下方的所有内容并将其从单元格 L2
开始粘贴到单独的工作表上。这只是一个很长的宏,我正在努力简化它。 For 循环会起作用吗?
试一试。除了 select 的原始单元格外,函数内的所有操作都是相同的,因此只需将其作为函数的输入即可。
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
我没有任何数据可以测试,但这可能有效(用这个替换你发布的所有代码):
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
据我了解,您实际上是在寻找需要从中复制数据的header。如果是这样的话:
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
- 如果您更喜欢此方法,您的变体已更新
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
- 恕我直言,最佳变体是
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
我正在编写一个 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 乘 1 地浏览各列以查看它是否包含特定的搜索词。如果是,它会复制其下方的所有内容并将其从单元格 L2
开始粘贴到单独的工作表上。这只是一个很长的宏,我正在努力简化它。 For 循环会起作用吗?
试一试。除了 select 的原始单元格外,函数内的所有操作都是相同的,因此只需将其作为函数的输入即可。
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
我没有任何数据可以测试,但这可能有效(用这个替换你发布的所有代码):
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
据我了解,您实际上是在寻找需要从中复制数据的header。如果是这样的话:
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
- 如果您更喜欢此方法,您的变体已更新
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
- 恕我直言,最佳变体是
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