代码简写问题

zhangzhezy

Sub 工资表_存档()
'工资表数据存档操作
    Dim i%, j%, k%, x%
    Dim A As Worksheet
    Dim B As Worksheet
   
    Set A = Sheets("工资表")
    Set B = Sheets("费用数据")
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
   x = MsgBox("确定数据正确后，更新数据！", vbOKCancel, "提示")
     If x = vbOK Then
       '用户按下“确认”，执行后续代码
   
    With B
        i = .Cells(Rows.Count, "H").End(xlUp).Row + 1
        For j = 2 To i - 1
            If A.Range("B2") = .Cells(j, "H") Then
                i = j
                Exit For
            End If
        Next
        
        For j = 2 To i - 1
            If A.Range("B2") = .Cells(j, "H") And A.Range("B2") = .Cells(j, "H") Then
                i = j
               Exit For
            End If
        Next
    End With
   
    With A
        B.Cells(i, 9) = .Range("B5"):
        B.Cells(i, 10) = .Range("B6"):
        B.Cells(i, 11) = .Range("B7"):
        B.Cells(i, 12) = .Range("B8"):
        B.Cells(i, 13) = .Range("B9"):
        B.Cells(i, 14) = .Range("B10"):
        B.Cells(i, 15) = .Range("B11"):
        B.Cells(i, 16) = .Range("B12"):
        B.Cells(i, 17) = .Range("B13"):
        B.Cells(i, 18) = .Range("B14"):
        B.Cells(i, 19) = .Range("B15"):
        B.Cells(i, 20) = .Range("B16"):
        B.Cells(i, 21) = .Range("B17"):
        B.Cells(i, 22) = .Range("B18"):
        B.Cells(i, 23) = .Range("B19"):
        B.Cells(i, 24) = .Range("B20"):
        B.Cells(i, 25) = .Range("B21"):
        B.Cells(i, 26) = .Range("B22"):
        B.Cells(i, 27) = .Range("B23"):
        B.Cells(i, 28) = .Range("B24"):
        B.Cells(i, 29) = .Range("B25"):
        B.Cells(i, 30) = .Range("B26"):
        B.Cells(i, 31) = .Range("B27"):
        B.Cells(i, 32) = .Range("B28"):
        B.Cells(i, 33) = .Range("B29"):
        B.Cells(i, 34) = .Range("B30"):
        B.Cells(i, 35) = .Range("B31"):
        B.Cells(i, 36) = .Range("B32"):
        B.Cells(i, 37) = .Range("B33"):
        B.Cells(i, 38) = .Range("B34"):
        B.Cells(i, 39) = .Range("B35"):
        B.Cells(i, 40) = .Range("B36"):
        B.Cells(i, 41) = .Range("B37"):
        B.Cells(i, 42) = .Range("B38"):
        B.Cells(i, 43) = .Range("B39"):
        B.Cells(i, 44) = .Range("B40"):
        B.Cells(i, 45) = .Range("B41"):
        B.Cells(i, 46) = .Range("B42"):
        B.Cells(i, 47) = .Range("B43"):
        B.Cells(i, 48) = .Range("B44"):
        B.Cells(i, 49) = .Range("B45"):
        B.Cells(i, 50) = .Range("B46"):
        B.Cells(i, 51) = .Range("B47"):
        B.Cells(i, 52) = .Range("B48"):
        B.Cells(i, 53) = .Range("B49"):
        B.Cells(i, 54) = .Range("B50"):
        B.Cells(i, 55) = .Range("B51"):
        B.Cells(i, 56) = .Range("B52"):
        B.Cells(i, 57) = .Range("B53"):
        B.Cells(i, 58) = .Range("B54"):
        B.Cells(i, 59) = .Range("B55"):
      
        End With
   
    'Call Report
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ActiveWorkbook.SAVE
    'MsgBox "数据已更新"
   
      ElseIf x = vbCancel Then
    '用户按下“取消”，退出程序
  End If
  
End Sub



其中

1. With A
   
2. B.Cells(i, 9) = .Range("B5"):
   
3. B.Cells(i, 10) = .Range("B6"):
   
4. B.Cells(i, 11) = .Range("B7"):
   
5. B.Cells(i, 12) = .Range("B8"):
   
6. B.Cells(i, 13) = .Range("B9"):
   
7. B.Cells(i, 14) = .Range("B10"):
   
8. B.Cells(i, 15) = .Range("B11"):
   
9. B.Cells(i, 16) = .Range("B12"):
   
10. B.Cells(i, 17) = .Range("B13"):
    
11. B.Cells(i, 18) = .Range("B14"):
    
12. B.Cells(i, 19) = .Range("B15"):
    
13. B.Cells(i, 20) = .Range("B16"):
    
14. B.Cells(i, 21) = .Range("B17"):
    
15. B.Cells(i, 22) = .Range("B18"):
    
16. B.Cells(i, 23) = .Range("B19"):
    
17. B.Cells(i, 24) = .Range("B20"):
    
18. B.Cells(i, 25) = .Range("B21"):
    
19. B.Cells(i, 26) = .Range("B22"):
    
20. B.Cells(i, 27) = .Range("B23"):
    
21. B.Cells(i, 28) = .Range("B24"):
    
22. B.Cells(i, 29) = .Range("B25"):
    
23. B.Cells(i, 30) = .Range("B26"):
    
24. B.Cells(i, 31) = .Range("B27"):
    
25. B.Cells(i, 32) = .Range("B28"):
    
26. B.Cells(i, 33) = .Range("B29"):
    
27. B.Cells(i, 34) = .Range("B30"):
    
28. B.Cells(i, 35) = .Range("B31"):
    
29. B.Cells(i, 36) = .Range("B32"):
    
30. B.Cells(i, 37) = .Range("B33"):
    
31. B.Cells(i, 38) = .Range("B34"):
    
32. B.Cells(i, 39) = .Range("B35"):
    
33. B.Cells(i, 40) = .Range("B36"):
    
34. B.Cells(i, 41) = .Range("B37"):
    
35. B.Cells(i, 42) = .Range("B38"):
    
36. B.Cells(i, 43) = .Range("B39"):
    
37. B.Cells(i, 44) = .Range("B40"):
    
38. B.Cells(i, 45) = .Range("B41"):
    
39. B.Cells(i, 46) = .Range("B42"):
    
40. B.Cells(i, 47) = .Range("B43"):
    
41. B.Cells(i, 48) = .Range("B44"):
    
42. B.Cells(i, 49) = .Range("B45"):
    
43. B.Cells(i, 50) = .Range("B46"):
    
44. B.Cells(i, 51) = .Range("B47"):
    
45. B.Cells(i, 52) = .Range("B48"):
    
46. B.Cells(i, 53) = .Range("B49"):
    
47. B.Cells(i, 54) = .Range("B50"):
    
48. B.Cells(i, 55) = .Range("B51"):
    
49. B.Cells(i, 56) = .Range("B52"):
    
50. B.Cells(i, 57) = .Range("B53"):
    
51. B.Cells(i, 58) = .Range("B54"):
    
52. B.Cells(i, 59) = .Range("B55"):
    
53. 
    
54. End With

复制代码

怎么简写，由于要计算的单元格太多，VBA提示过程太大！谢谢大神赐教！

杨建营

With A
for j= 5 to 55
B.Cells(i, j+4) = .Range("B" & j):
next
End With
楼主这样试试。

zhangzhezy

杨建营 发表于 2023-7-5 18:27
With A
for j= 5 to 55
B.Cells(i, j+4) = .Range("B" & j):

谢谢，问题解决

吴中泉

楼主这是接了一个大工程啊

micch

看数字都是连续的，不应该一个一个输出，存入一个数组变量，一次性输出会快很多

zyhui1961

吴中泉 发表于 2023-7-5 21:43
楼主这是接了一个大工程啊

请老师有时间了看一下，谢谢了！
https://club.excelhome.net/thread-1667075-1-1.html

沈默00

楼主真的很用心，都看晕了，VBA专做重复处理的事，不会这么长的，论坛里多看下，.....我也小白呀，共勉共勉！

于箱长

沈默00 发表于 2023-7-6 07:32
楼主真的很用心，都看晕了，VBA专做重复处理的事，不会这么长的，论坛里多看下，.....我也小白呀，共勉共勉 ...

来得好早

liulang0808

B.Cells(i, 9).resize(51) .value= .Range("B5").resize(51) .value
楼主自己测试看看是否可行

smiletwo