复制代码30次以上,略有不同?

时间:2018-01-24 20:46:16

标签: excel vba excel-vba

我想知道是否有可能复制我的代码30次,略微改变FIND功能,找到不同的项目“新食品价格,新比萨价格,新海鲜价格等等” 如果我将整个代码复制34次将会非常长,如果有任何改变,我将不得不改变它34次。是否可以重复大部分代码34次,只需更改FIND字和&粘贴的公式?

Dim rng As Range
  Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:FF1")
    Set rFind = .Find(What:="US", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        LastColumn = rFind.Column
    End If
End With
Set rng = Range(Cells(2, LastColumn), Cells(2, LastColumn + 7))
final_Column = Application.Match("New Food Price", rng, 0)
LastColumn = LastColumn + final_Column
Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Cells(2, LastColumn).Select
ActiveCell.Value = "New Food Price"
ActiveCell.Interior.ColorIndex = 22
    Range(Cells(3, (LastColumn)), Cells(LR, (LastColumn))).Formula = "=(5)"
    LastColumn = LastColumn + 1
    Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.Cells(2, LastColumn).Select
ActiveCell.Value = "Difference"
ActiveCell.Interior.ColorIndex = 22
    Range(Cells(3, (LastColumn)), Cells(LR, (LastColumn))).Formula = "=(6)"


Set rng = Range(Cells(2, LastColumn), Cells(2, LastColumn + 7))
final_Column2 = Application.Match("New Wine Price", rng, 0)
LastColumn = LastColumn + final_Column2
Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Cells(2, LastColumn).Select
ActiveCell.Value = "New Wine Price"
ActiveCell.Interior.ColorIndex = 22
    Range(Cells(3, (LastColumn)), Cells(LR, (LastColumn))).Formula = "=(5)"
    LastColumn = LastColumn + 1
    Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.Cells(2, LastColumn).Select
ActiveCell.Value = "Difference"
ActiveCell.Interior.ColorIndex = 22
    Range(Cells(3, (LastColumn)), Cells(LR, (LastColumn))).Formula = "=(6)"

1 个答案:

答案 0 :(得分:1)

你走了!

Sub SearchAll()
    Dim SearchTerms As Variant
    SearchTerms = Array("US", "UK", "BR")

    For Each SearchTerm In SearchTerms
        Search SearchTerm
    Next

End Sub

Sub Search(SearchTerm)
    Dim rng As Range
    Dim LR As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    With Range("A1:FF1")
        Set rFind = .Find(What:=SearchTerm, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFind Is Nothing Then
            LastColumn = rFind.Column
        End If
    End With
    ...
    ...
End Sub

根据要求做一个简短的解释:

第一个Sub创建一个搜索词数组。然后使用For Each逐步完成。对于每个值,使用一个参数调用Search方法。然后在Find调用中使用此参数。