关于录入问题

gzy001

从网上找了一段录入代码，录入出错，但在别的表格能用，请高手们帮看一下，问题出在什么地方。

杨建营

UBound(Voucher_Data, 1)换成LastR_Voucher_Summary试试。

gzy001

谢谢，那么给我回复，试了下还是这个问题。

杨建营

gzy001 发表于 2025-3-28 09:50
谢谢，那么给我回复，试了下还是这个问题。

数组取交接单的数据。 运行结果

杨建营

gzy001 发表于 2025-3-28 09:50
谢谢，那么给我回复，试了下还是这个问题。

1. Private Sub CommandButton2_Click()
   
2.     Dim i As Integer
   
3.     Dim Voucher_Data
   
4.     Dim LastR_Voucher_Input As Integer
   
5.     Dim LastR_Voucher_Summary As Long
   
6.     Dim nRow&, nRow2&, Arr(), bh$
   
7.     Dim x, y
   
8. 
   
9.     Application.ScreenUpdating = False
   
10.     Application.EnableEvents = False
    
11.     ActiveSheet.Unprotect "1234"
    
12.     If MsgBox("是否已打印凭证，保存后会清空数据，继续吗？", 36, "询问") = 6 Then
    
13.         With Worksheets("交接单")
    
14.             Arr = .Range("a4:g15").Value
    
15.             bh = .Range("k3").Value
    
16.             'bh = Format(Date, "yymmdd") & Format(Val(Right(bh, 4)), "0000")
    
17. ' .Range("g3").Value = Date
    
18. '       .Range("k3").Value = bh
    
19.    For i = 4 To 15
    
20.       If WorksheetFunction.CountA(.Range("a" & i & ":g" & i)) > 0 Then LastR_Voucher_Input = i
    
21.    Next
    
22.    If LastR_Voucher_Input = 0 Then MsgBox "还未输入任何内容。", vbCritical: Exit Sub
    
23.   ' For i = 5 To LastR_Voucher_Input
    
24.      ' If WorksheetFunction.CountA(.Range("c" & i & ":g" & i)) < 2 Then
    
25.         ' MsgBox "有两项为空，不能保存！", vbCritical
    
26.         ' Exit Sub
    
27.      ' End If
    
28.   'Next
    
29.    If [g2] = "" Or [b4] = "" Then
    
30.       MsgBox "用途，供应商未填，不能保存。", vbCritical
    
31.       Exit Sub
    
32.    End If
    
33.    Voucher_Data = .Range("a4:g" & LastR_Voucher_Input)
    
34.    '.Range("k3") = Voucher_Start_Year & "第" & Voucher_Start_No & "号"
    
35. End With
    
36. With Worksheets("交接库")
    
37.     LastR_Voucher_Summary = 0
    
38.    Do
    
39.       LastR_Voucher_Summary = LastR_Voucher_Summary + 1
    
40.    Loop Until WorksheetFunction.CountA(.Range("c" & LastR_Voucher_Summary & ":l" & LastR_Voucher_Summary)) = 0
    
41.    .Cells(LastR_Voucher_Summary, 2).Resize(LastR_Voucher_Summary, UBound(Voucher_Data, 2)) = Voucher_Data
    
42.    .Cells(LastR_Voucher_Summary, 1).Resize(LastR_Voucher_Summary, 1) = [g2] '同样从别的表复制过来，这里的取值范围不是活动的了。
    
43.   '  .Cells(LastR_Voucher_Summary, 13).Resize(UBound(Voucher_Data, 1), 1) = [d3]
    
44.   '   .Cells(LastR_Voucher_Summary, 14).Resize(UBound(Voucher_Data, 1), 1) = [m9]
    
45. End With
    
46. 'Sheets("交接单").Select
    
47. 'Range("g2").Select
    
48. 'Selection.Copy
    
49. 'Sheets("交接库").Select
    
50. 'y = Range("a10000").End(xlUp).Row
    
51. 'x = Range("b10000").End(xlUp).Row
    
52. ' Range("u5:u" & y).Select
    
53. 'Range("a" & y & ":a" & x).Select
    
54. ' Range(i:a & x).Select
    
55. ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
56.         :=False, Transpose:=False
    
57. ' With Sheet3
    
58.        ' bh = Format(Date, "yymmdd") & Format(Val(Right(bh, 4)) + 1, "0000")
    
59.        ' .Range("g3").Value = Date
    
60.      '   .Range("k3").Value = bh
    
61.     '    .Range("c5:i10").ClearContents
    
62.      '   .Range("k5:l10").ClearContents
    
63.      '   .Range("m9").ClearContents
    
64.        ' .Range("d3").ClearContents
    
65.        ' .Range("d3").MergeArea.Clear'删除合并单元格内容及格式
    
66.      '   .Range("d3").MergeArea.ClearContents ' 清除合并单元格的内容但不删除格式?
    
67.         'Sheet1.Cells(1, 1).Resize(2, 3).ClearContents'清除合并单元格的内容,未测试。
    
68.    ' End With
    
69.    
    
70.   
    
71. 
    
72. Application.ScreenUpdating = True
    
73.     End If
    
74.     Application.EnableEvents = True
    
75.     'ActiveSheet.Protect "1234"
    
76.     'Workbooks("支出凭证.xlsm").Save
    
77. 
    
78. End Sub
    

复制代码

代码如上

gzy001

杨建营 发表于 2025-3-28 09:59
代码如上

谢谢，不知是什么原因，你运行没问题，我这还是老样，麻烦你直接发一下附件我直接试一下，行不行，这个代码是我一直在用的复制过来，但到这里就不对了，不知是那里的问题。

feilanga

这个需要单号，才能回查，修改，删除。没有难度就是对应数据关系。

杨建营

gzy001 发表于 2025-3-28 10:09
谢谢，不知是什么原因，你运行没问题，我这还是老样，麻烦你直接发一下附件我直接试一下，行不行，这个代 ...

请楼主参考。

gzy001

谢谢，学习一下。

gzy001

杨建营 发表于 2025-3-28 10:37
请楼主参考。

你好谢谢，附件收到，我这边打开我试了下，每次录入日期会多2行。