2016-07-26 138 views
1

我有一个VBA脚本,可以将数据从一张表复制到另一张。将复制的数据放入公式中,并将计算的数量复制回原始工作表。我试图获得它,以便VBA脚本为每一行都做到这一点。我有1000行数据。Excel VBA - 让VBA脚本遍历行

Sub Rating() 
Dim ws1 As Worksheet, ws2 As Worksheet 
Set ws1 = Worksheets("SoapUI - Single") 
Set ws2 = Worksheets("STpremcalc") 

     ws2.Range("B3").Value = ws1.Range("B3").Value 

     ws2.Range("B4").Value = ws1.Range("C3").Value 

     ws2.Range("B5").Value = ws1.Range("D3").Value 

     ws2.Range("B6").Value = ws1.Range("E3").Value 

     ws2.Range("E3").Value = ws1.Range("F3").Value 

     ws2.Range("E4").Value = ws1.Range("G3").Value 

     ws2.Range("E5").Value = ws1.Range("H3").Value 

     ws2.Range("E6").Value = ws1.Range("I3").Value 

     ws2.Range("G3").Value = ws1.Range("J3").Value 

     ws2.Range("G4").Value = ws1.Range("K3").Value 

     ws2.Range("G5").Value = ws1.Range("L3").Value 

     ws2.Range("J3").Value = ws1.Range("N3").Value 

     ws2.Range("J4").Value = ws1.Range("O3").Value 

     ws2.Range("J6").Value = ws1.Range("P3").Value 

     ws2.Range("B9").Value = ws1.Range("Q3").Value 

     ws2.Range("C9").Value = ws1.Range("R3").Value 

     ws2.Range("D9").Value = ws1.Range("S3").Value 

     ws2.Range("E9").Value = ws1.Range("T3").Value 

     ws2.Range("B10").Value = ws1.Range("U3").Value 

     ws2.Range("C10").Value = ws1.Range("V3").Value 

     ws2.Range("D10").Value = ws1.Range("W3").Value 

     ws2.Range("E10").Value = ws1.Range("X3").Value 

     ws2.Range("B11").Value = ws1.Range("Y3").Value 

     ws2.Range("C11").Value = ws1.Range("Z3").Value 

     ws2.Range("D11").Value = ws1.Range("AA3").Value 

     ws2.Range("E11").Value = ws1.Range("AB3").Value 

     ws1.Range("AW3").Value = ws2.Range("M4").Value 

     ws1.Range("AX3").Value = ws2.Range("M5").Value 

     ws1.Range("AY3").Value = ws2.Range("M6").Value 

End Sub 

我也明白,这可能是执行此任务非常低效的方式,但我不知道如何更好的IT。所以如果你有办法让这个更有效率,那将不胜感激。

编辑:更新的代码为每@ user3598756建议

+1

问题是你粘贴的范围似乎没有任何移动到下一个位置的模式,因此一个循环需要一个** lot **的if/else类型语法,可能同样效率低下。 –

+0

唯一会改变的是复制数据的行号。 (“B”和i).Copy' '表格(“STpremcalc”)。范围(“B3”)。PasteSpecial粘贴:= xlValues' – Ross

回答

3

我不是复制/粘贴过程的粉丝,但如果你必须使用它,然后下面的语句

Sheets("SoapUI - Single").Range("B3").Copy 
Sheets("STpremcalc").Range("B3").PasteSpecial Paste:=xlValues 

Sheets("SoapUI - Single").Range("C3").Copy 
Sheets("STpremcalc").Range("B4").PasteSpecial Paste:=xlValues 

Sheets("SoapUI - Single").Range("D3").Copy 
Sheets("STpremcalc").Range("B5").PasteSpecial Paste:=xlValues 

Sheets("SoapUI - Single").Range("E3").Copy 
Sheets("STpremcalc").Range("B6").PasteSpecial Paste:=xlValues 

可以简化为

Sheets("SoapUI - Single").Range("B3:E3").Copy 
Sheets("STpremcalc").Range("B3").PasteSpecial Paste:=xlValues, Transpose:=True 

其他比以上,你可以简化

Sheets("SoapUI - Single").Range("Q3").Copy 
    Sheets("STpremcalc").Range("B9").PasteSpecial Paste:=xlValues 

    Sheets("SoapUI - Single").Range("R3").Copy 
    Sheets("STpremcalc").Range("C9").PasteSpecial Paste:=xlValues 

    Sheets("SoapUI - Single").Range("S3").Copy 
    Sheets("STpremcalc").Range("D9").PasteSpecial Paste:=xlValues 

    Sheets("SoapUI - Single").Range("T3").Copy 
    Sheets("STpremcalc").Range("E9").PasteSpecial Paste:=xlValues 

Sheets("SoapUI - Single").Range("Q3:T3").Copy 
    Sheets("STpremcalc").Range("B9:E9").PasteSpecial Paste:=xlValues 

我认为你可以自己做休息。


编辑:由于OP编辑他的问题。以下可通过使用像这样

For i = 1 To 4 
    ws2.Cells(i + 2, 2) = ws1.Cells(3, i + 1) 'Or you can use `ws1.Cells(3, i + 1).Value2` if you only need the value without its format like date or currency 
    ws2.Cells(i + 2, 5) = ws1.Cells(3, i + 5) 
Next i 

的剩下的是你的过程被简化

ws2.Range("B3").Value = ws1.Range("B3").Value 

    ws2.Range("B4").Value = ws1.Range("C3").Value 

    ws2.Range("B5").Value = ws1.Range("D3").Value 

    ws2.Range("B6").Value = ws1.Range("E3").Value 

    ws2.Range("E3").Value = ws1.Range("F3").Value 

    ws2.Range("E4").Value = ws1.Range("G3").Value 

    ws2.Range("E5").Value = ws1.Range("H3").Value 

    ws2.Range("E6").Value = ws1.Range("I3").Value 

+0

我已更新我的代码 – Ross

+0

@RossWatson查看我的编辑。我相信你可以做剩下的事情。 –

1

不多做,但是这一点可能是:

  • 使用变量引用的工作表,并同时提高代码的可读性和效率

    Dim ws1 As Worksheet, ws2 As Worksheet  
    Set ws1 = Worksheets("SoapUI - Single") 
    Set ws2 = Worksheets("STpremcalc") 
    
  • 使用Range1.Value = Range2.Value模式复制/粘贴范围之间的值它的'

    ws2.Range("B3").Value = ws1.Range("B3").Value 
    ws2.Range("B4").Value = ws1.Range("C4").Value 
    ... 
    
+0

既然您改编了我的解决方案,您为什么不将我的答案标记为已接受? – user3598756

+0

@Ross:你会很高兴给予正确的反馈给帮助你的人 – user3598756