[英]Copy Range From One Sheet Paste Part of Range In Same Sheet Based On Cell Value On Another Sheet
Right now I've created a code to copy values from one range to another range based on the value from another sheet (the copy and paste happens on one sheet). 现在,我已经创建了一个代码,用于根据另一张纸上的值将一个范围内的值复制到另一个范围内(复制和粘贴发生在一张纸上)。
But because this value can be one of twelve values, the range that is being copied and pasted becomes smaller. 但是因为此值可以是十二个值之一,所以要复制和粘贴的范围会变小。
Because I'm not adept at VBA I created dozens of copy ranges and dozens of paste ranges in Excel to handle ElseIf statements via VBA to copy and paste depending on what the cell value is in the other sheet. 由于我不擅长VBA,因此我在Excel中创建了数十个复制范围和数十个粘贴范围,以通过VBA处理ElseIf语句以根据另一张工作表中的单元格值进行复制和粘贴。
I'm curious, is there a way to make my code more optimized and have less named ranges in my workbook? 我很好奇,有没有办法使我的代码更优化,并在工作簿中减少命名范围?
Any help would be appreciated, here's my code pasted below (each named range for both the copy and paste is simply one less column due to what the selections can be in the first sheet): 任何帮助将不胜感激,这是我的代码粘贴在下面(由于第一页中的选择内容,复制和粘贴的每个命名范围仅减少了一个列):
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
Using string manipulation and a loop you could greatly reduce the size of that code: 使用字符串操作和循环,可以大大减少代码的大小:
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
if the actual code is something like this 如果实际的代码是这样的
"oneone", "onetwo", "onethree", ..., "oneeleven", "twoone", "twotwo", "twothree", ... "twoeleven" ... “ oneone”,“ onetwo”,“ onethree”,...,“ oneeleven”,“ twoone”,“ twotwo”,“ twothree”,...“ twoeleven” ...
(11x11 strings) you could use a double loop over this array: (11x11个字符串),您可以在此数组上使用双循环:
dim arrStrings(1 to 11) as string
arrStrings(1) = "One"
arrStrings(2) = "Two"
arrStrings(2) = "Three"
...
arrStrings(11) = "Nine"
and you can create the string like this Str = "CopyFormulasFT"+ arrstrings(i) + arrstrings(j) 您可以创建像这样的字符串Str =“ CopyFormulasFT” + arrstrings(i)+ arrstrings(j)
is there a way to make my code more optimized and have less named ranges in my workbook?
有没有一种方法可以使我的代码更优化,并在工作簿中减少命名范围?
depends on how your data organized. 取决于数据的组织方式。 But now, you can slightly simplify your code:
但是现在,您可以稍微简化一下代码:
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
Another approach, this one much more flexible and easier to update: 另一种方法,这种方法更加灵活并且更易于更新:
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
In the case that you need to add more named ranges following your pattern, just editing str0
, str1
, and str2
is enough. 如果您需要在模式之后添加更多命名范围,只需编辑
str0
, str1
和str2
就足够了。
Let us know if this helps. 让我们知道是否有帮助。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.