2017-06-04 187 views
0

我想复制Sheet1范围A1:A100中的范围,其中每个单元格填充值为“Animal”,“Plant”,“Rock”和“Sand”。然后,如果值为“Plant”时粘贴“2”等,则在范围A1:A100的值为“Animal”的情况下粘贴带有“1”的条件时,我想粘贴Sheet2范围B1:B100。VBA - Excel复制并粘贴标准范围

我如何编写VBA代码?简单并减少内存使用量。 我的代码:

Sub copyrange() 
    Dim i   As Long 
    Dim lRw   As Long 
    Dim lRw_2  As Long 


    Application.ScreenUpdating = False 
    lRw = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row 
    ThisWorkbook.Sheets("Sheet1").Activate 

    For i = 1 To lRw 
     Range("A" & i).Copy 
     lRw_2 = Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row + 1 
     Sheets("Sheet1").Activate 
     'I not sure for this one, the code is too long 
      Select Case ThisWorkbook.Sheets("sheet1").Range("A" & i).Value 
      Case "Animal" 
      With Sheets("Sheet2").Range("B" & lRw_2) 
      .Value = 1 
      End With 
      Case "Plant" 
      With Sheets("Sheet2").Range("B" & lRw_2) 
      .Value = 2 
      End With 
      Case "Rock" 
      With Sheets("Sheet2").Range("B" & lRw_2) 
      .Value = 3 
      End With 
      Case "Sand" 
      With Sheets("Sheet2").Range("B" & lRw_2) 
      .Value = 4 
      End With 
      End Select 
     Sheets("Sheet1").Activate 
    Next i 
    Application.ScreenUpdating = True 
End Sub 

在此先感谢。

+0

请出示你已经尝试了什么。 – YowE3K

+0

你有什么问题?上面的代码是否会给你一个错误?如果是这样,哪些错误和哪些代码行? 如果它没有任何错误,并且您只是想要改进代码的建议,则应将此问题迁移到Code Review。 – puzzlepiece87

+0

上面的代码不会给我一个错误..你是对的...我想改善代码。也许任何人都可以用简单的代码给我同样的东西。我只是在想,如果有很多数据的范围,即2.000个单元或更多?我确定我的excel可以慢慢工作..你有什么建议..? –

回答

0

试试这个:

Option Explicit 

Public Sub replaceItems() 
    Application.ScreenUpdating = False 
    With Sheets(2).Range("B1:B100") 
     .Value2 = Sheets(1).Range("A1:A100").Value2 
     .Replace What:="Animal", Replacement:=1, LookAt:=xlWhole 
     .Replace What:="Plant", Replacement:=2, LookAt:=xlWhole 
     .Replace What:="Rock", Replacement:=3, LookAt:=xlWhole 
     .Replace What:="Sand", Replacement:=4, LookAt:=xlWhole 
    End With 
    Application.ScreenUpdating = True 
End Sub 
+0

感谢您的代码,它的工作。它非常简单的代码。 :-) –