求助优化录入数据的VBA代码

jhwei2

昨晚写好没测试，再试试这个看看

1. Sub 成品入库()
   
2.     Dim rowC%, arr, brr, endrow%
   
3.     rowC = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
   
4.     endrow = Sheet30.Range("C" & Rows.Count).End(xlUp).Row
   
5.     arr = Sheet1.Range("A5:X" & rowC)
   
6.     brr = Sheet30.Range("A6:P" & endrow)
   
7.     Dim i%, j%, str As String
   
8.     For j = 1 To UBound(brr)
   
9.         For i = 1 To UBound(arr)
   
10.             If brr(j, 3) = arr(i, 3) And brr(j, 4) = arr(i, 8) Then
    
11.                 With Sheet1
    
12.                     .Cells(i + 4, "X") = arr(i, 24) + brr(j, 16)
    
13.                     If .Cells(i + 4, "X").Comment Is Nothing Then
    
14.                           .Cells(i + 4, "X").AddComment
    
15.                           .Cells(i + 4, "X").Comment.Text Text:=brr(j, 15) & "入库" & brr(j, 16) & "台；"
    
16.                     Else
    
17.                           str = .Cells(i + 4, "X").Comment.Text
    
18.                           .Cells(i + 4, "X").ClearComments
    
19.                           .Cells(i + 4, "X").Comment.Text Text:=str & Chr(10) & brr(j, 15) & "入库" & brr(j, 16) & "台；"
    
20.                     End If
    
21.                     If arr(i, 20) = Empty Then .Cells(i + 4, "I") = brr(j, 9)
    
22.                     If arr(i, 23) = Empty Then .Cells(i + 4, "W") = brr(j, 15)
    
23.                 End With
    
24.             End If
    
25.         Next i
    
26.     Next j
    
27.     MsgBox "成品入库成功。"
    
28. End Sub

复制代码

jhwei2

GUANCHZH 发表于 2018-9-23 12:46
就是没有反应，数据录入不进去。

代码改了下，回复还需要审核……好麻烦

GUANCHZH

jhwei2 发表于 2018-9-23 13:30
昨晚写好没测试，再试试这个看看

非常感谢老师的帮助，问题完美解决，谢谢老师！！！