Question

现在我已经创建了一个代码，可以根据另一个工作表中的值将值从一个范围复制到另一个范围（复制和粘贴发生在一个工作表上）。

但是因为这个值可以是十二个值中的一个，所以复制和粘贴的范围会变小。

因为我不擅长VBA，所以我在Excel中创建了几十个拷贝范围和几十个粘贴范围，通过VBA处理ElseIf语句，根据单元格在另一个工作表中的内容进行复制和粘贴。

我很好奇，有没有办法让我的代码更优化，并且在我的工作簿中命名范围更少？

任何帮助将不胜感激，这里是我的代码粘贴在下面（复制和粘贴的每个命名范围只是一个较少的列，因为第一张表中的选项可以是：）

SubTest()

If ws0.Range("D6") = "BUD" Then    
    ws1.Range("CopyFormulasFT").Select
    Selection.Copy
    ws1.Range("PasteFormulasFT").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F01" Then
    ws1.Range("CopyFormulasFTOneEleven").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTOneEleven").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F02" Then
    ws1.Range("CopyFormulasFTTwoTen").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTTwoTen").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F03" Then
    ws1.Range("CopyFormulasFTThreeNine").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTThreeNine").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F04" Then
    ws1.Range("CopyFormulasFTFourEight").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTFourEight").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F05" Then
    ws1.Range("CopyFormulasFTFiveSeven").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTFiveSeven").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F06" Then
    ws1.Range("CopyFormulasFTSixSix").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTSixSix").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F07" Then
    ws1.Range("CopyFormulasFTSevenFive").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTSevenFive").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F08" Then
    ws1.Range("CopyFormulasFTEightFour").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTEightFour").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F09" Then
    ws1.Range("CopyFormulasFTNineThree").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTNineThree").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F10" Then
    ws1.Range("CopyFormulasFTTenTwo").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTTenTwo").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

ElseIf ws0.Range("D6") = "F11" Then
    ws1.Range("CopyFormulasFTElevenOne").Select
    Selection.Copy
    ws1.Range("PasteFormulasFTElevenOne").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False

End If

End Sub

Answer 1

使用字符串操作和循环可以大大减小代码的大小：

dim arrStrings(1 to 11) as string
arrStrings(1) = "OneEleven"
arrStrings(2) = "TwoTen"
arrStrings(2) = "ThreeNine"
...
arrStrings(11) = "NineThree"

 dim  i as integer
    for i = 1 to 11
        If ws0.Range("D6") = "F"+ strings.trim(str(i)) Then
             ws1.Range("CopyFormulasFT" + arrStrings(i)).Select
             Selection.Copy
             ws1.Range("PasteFormulasFT" + arrStrigns(i)).Select
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
             SkipBlanks:=True, Transpose:=False
        end if
    next i

如果实际代码是这样的

“oneone”，“onetwo”，“onethree”，...，“oneeleven”，“twoone”，“twotwo”，“twothree”，......“twoeleven”......

（11x11个字符串）你可以在这个数组上使用双循环：

dim arrStrings(1 to 11) as string
arrStrings(1) = "One"
arrStrings(2) = "Two"
arrStrings(2) = "Three"
...
arrStrings(11) = "Nine"

你可以像这样创建字符串 Str =“CopyFormulasFT”+ arrstrings（i）+ arrstrings（j）

Answer 2

有没有办法让我的代码更优化，并且在我的工作簿中命名范围更少？

取决于您的数据组织方式。但现在，您可以略微简化代码：

Sub Test()
    Dim destRng As String
    Dim sorceRng As String

    Select Case ws0.Range("D6")
        Case "BUD"
            sorceRng = "CopyFormulasFT": destRng = "PasteFormulasFT"
        Case "F01"
            sorceRng = "CopyFormulasFTOneEleven": destRng = "PasteFormulasFTOneEleven"
        Case "F02"
            sorceRng = "CopyFormulasFTTwoTen": destRng = "PasteFormulasFTTwoTen"
        Case "F03"
            sorceRng = "CopyFormulasFTThreeNine": destRng = "PasteFormulasFTThreeNine"
        Case "F04"
            sorceRng = "CopyFormulasFTFourEight": destRng = "PasteFormulasFTFourEight"
        Case "F05"
            sorceRng = "CopyFormulasFTFiveSeven": destRng = "PasteFormulasFTFiveSeven"
        Case "F06"
            sorceRng = "CopyFormulasFTSixSix": destRng = "PasteFormulasFTSixSix"
        Case "F07"
            sorceRng = "CopyFormulasFTSevenFive": destRng = "PasteFormulasFTSevenFive"
        Case "F08"
            sorceRng = "CopyFormulasFTEightFour": destRng = "PasteFormulasFTEightFour"
        Case "F09"
            sorceRng = "CopyFormulasFTNineThree": destRng = "PasteFormulasFTNineThree"
        Case "F10"
            sorceRng = "CopyFormulasFTTenTwo": destRng = "PasteFormulasFTTenTwo"
        Case "F11"
            sorceRng = "CopyFormulasFTElevenOne": destRng = "PasteFormulasFTElevenOne"
        Case Else
            Exit Sub
    End Select

    ws1.Range(sorceRng).Copy
    ws1.Range(destRng).PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True

End Sub

Answer 3

另一种方法，这种方法更灵活，更容易更新：

Sub CondCopy()

    Dim ws0 As Worksheet, ws1 As Worksheet
    Dim str0 As String, str1 As String, str2 As String
    Dim strCond As String, ArrLoc As Long
    Dim strCopy As String, strPaste As String, strNum As String

    With ThisWorkbook
        Set ws0 = .Sheets("Sheet1")
        Set ws1 = .Sheets("Sheet2")
    End With

    str0 = ";One;Two;Three;Four;Five;Six;Seven;Eight;Nine;Ten;Eleven"
    str1 = ";Eleven;Ten;Nine;Eight;Seven;Six;Five;Four;Three;Two;One"
    str2 = "BUD;F01;F02;F03;F04;F05;F06;F07;F08;F09;F10;F11"
    strCond = ws0.Range("D6").Value

    ArrLoc = Application.Match(strCond, Split(str2, ";"), 0) - 1
    strNum = Split(str0, ";")(ArrLoc) & Split(str1, ";")(ArrLoc)

    strCopy = "CopyFormulasFT" & strNum
    strPaste = "PasteFormulasFT" & strNum

    With ws1
        .Range(strCopy).Copy
        .Range(strPaste).PasteSpecial xlPasteValues, SkipBlanks:=True
    End With

End Sub

如果您需要在模式后添加更多命名范围，只需编辑str0，str1和str2即可。

如果有帮助，请告诉我们。

从一张纸复制范围根据另一张纸上的单元格值在同一张纸上粘贴部分范围

3 个答案: