1

現在、別のシートの値に基づいて、ある範囲から別の範囲に値をコピーするコードを作成しました (コピーと貼り付けは 1 つのシートで行われます)。

ただし、この値は 12 個の値のいずれかになる可能性があるため、コピーして貼り付ける範囲は狭くなります。

私はVBAに慣れていないので、Excelで数十のコピー範囲と数十の貼り付け範囲を作成して、VBAを介してElseIfステートメントを処理し、他のシートのセル値に応じてコピーして貼り付けました。

コードをより最適化し、ブック内の名前付き範囲を少なくする方法はありますか?

以下に私のコードを貼り付けます（最初のシートで選択できるため、コピーと貼り付けの両方の名前付き範囲は単に1列少ないだけです）：

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 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 に答える
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 に答える