1

现在，我创建了一个代码，用于根据另一张纸上的值将值从一个范围复制到另一个范围（复制和粘贴发生在一张纸上）。

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

因为我不擅长 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
4

3 回答 3

3

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

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)

于 2014-02-18T19:24:55.283 回答
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
于 2014-02-18T19:04:49.290 回答
2

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

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就足够了。

让我们知道这是否有帮助。

于 2014-02-18T20:16:04.097 回答