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

3 回答

• 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 和_973306就足够了 .

  如果这有帮助，请告诉我们 .

  回复于 2024-05-06T05:18:19+08:00
• 2

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

  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）

  回复于 2024-05-06T05:18:19+08:00
• 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
  

  回复于 2024-05-06T05:18:19+08:00