[已解决]导出来的新表多一行，帮帮忙

hhxq001

导出的新表后面多一行，不知道怎么回事，大伙儿看看哪里的问题

0328求助 - 多一行.zip (315.76 KB, 下载次数: 3)

2021-3-28 15:19 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

caizhiliang

2021-3-28 16:04

这个很简单的  n=1   删了    把   n=n+1   放在判断后的第一行

1. Sub 导出薪金基数18_Click()
   
2.    
   
3.    
   
4.     Application.DisplayAlerts = False
   
5.     Application.ScreenUpdating = False
   
6.     ActiveSheet.Select '选择当前活动表
   
7.     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
   
8.         , AllowFiltering:=True, AllowUsingPivotTables:=True
   
9.     ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
   
10.         False, AllowFiltering:=True, AllowUsingPivotTables:=True
    
11.     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
    
12.         False, AllowFiltering:=True, AllowUsingPivotTables:=True
    
13.     ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
    
14.         True, AllowFiltering:=True, AllowUsingPivotTables:=True
    
15.     ActiveSheet.Unprotect
    
16.    
    
17.     Dim arr, x%, n%, brr
    
18.     Dim aa
    
19.     aa = ActiveSheet.Range("b2:w2").Value
    
20.    
    
21.     arr = ActiveSheet.Range("a4:w" & Range("C65536").End(3).Row)
    
22.     '定义新表的列数
    
23.     ReDim brr(1 To UBound(arr), 1 To 22)
    
24.     For x = 1 To UBound(arr)
    
25.         If arr(x, 5) = "" Then Exit For
    
26.         If arr(x, 6) <> 0 Then
    
27.              n = n + 1
    
28.             brr(n, 1) = arr(x, 2)
    
29.             brr(n, 2) = arr(x, 3) '即姓名列
    
30.             brr(n, 3) = arr(x, 4)
    
31.             brr(n, 4) = arr(x, 5)
    
32.             brr(n, 5) = arr(x, 6)
    
33.             brr(n, 6) = arr(x, 7)
    
34.             brr(n, 7) = arr(x, 8)
    
35.             brr(n, 8) = arr(x, 9)
    
36.             brr(n, 9) = arr(x, 10)
    
37.             brr(n, 10) = arr(x, 11)
    
38.             brr(n, 11) = arr(x, 12)
    
39.             brr(n, 12) = arr(x, 13)
    
40.             brr(n, 13) = arr(x, 14)
    
41.             brr(n, 14) = arr(x, 15)
    
42.             brr(n, 15) = arr(x, 16)
    
43.             brr(n, 16) = arr(x, 17)
    
44.             brr(n, 17) = arr(x, 18)
    
45.             brr(n, 18) = arr(x, 19)
    
46.             brr(n, 19) = arr(x, 20)
    
47.             brr(n, 20) = arr(x, 21)
    
48.             brr(n, 21) = arr(x, 22)
    
49.             brr(n, 22) = arr(x, 23)
    
50.            
    
51.         End If
    
52.     Next
    
53.    
    
54.     Dim yf '创建变量
    
55.     Dim nf '创建变量
    
56.     yf = [g1] '=f1单元格的内容-月份
    
57.     nf = [e1] '年份=e1单元格的内容
    
58.    
    
59.     '查找并创建“个税测算”文件夹
    
60.     If Len(Dir("e:" & nf & "导出", vbDirectory)) < 1 Then
    
61.         MkDir "e:" & nf & "导出" '创建新文件夹
    
62.     End If
    
63.    
    
64.     '创建一个新工作簿
    
65.     Dim wb
    
66.     Set wb = Workbooks.Add
    
67.     With wb.Sheets(1)
    
68.         .Columns("D").NumberFormatLocal = "@"
    
69.         
    
70.         '表头各列对应的字段：
    
71.         .[a1:v1] = aa
    
72.         .[a2].Resize(n, 22) = brr
    
73.         .Columns("A:v").EntireColumn.AutoFit
    
74.         Range("a1:v" & Range("c65536").End(3).Row).Borders.LineStyle = 1
    
75.         
    
76.     End With
    
77.     wb.SaveAs "e:" & nf & "导出" & yf & "月初薪金-" & Format(Now(), "mmdd-hhmmss") & ".xlsx" '保存在“某年导出”文件夹中，文件名=d1+月+原表名+导出日期
    
78.     wb.Close
    
79.    
    
80.     MsgBox "OK，月初薪金已导出，并保存在“e:" & nf & "导出”文件夹中！", vbyesonly, "温馨提示"
    
81.    
    
82.     Application.ScreenUpdating = True '刷屏功能
    
83.     Application.DisplayAlerts = True '弹窗警示
    
84.    
    
85. End Sub

复制代码

跳转到最佳答案楼层

caizhiliang

这个很简单的  n=1   删了    把   n=n+1   放在判断后的第一行

1. Sub 导出薪金基数18_Click()
   
2.    
   
3.    
   
4.     Application.DisplayAlerts = False
   
5.     Application.ScreenUpdating = False
   
6.     ActiveSheet.Select '选择当前活动表
   
7.     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
   
8.         , AllowFiltering:=True, AllowUsingPivotTables:=True
   
9.     ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
   
10.         False, AllowFiltering:=True, AllowUsingPivotTables:=True
    
11.     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
    
12.         False, AllowFiltering:=True, AllowUsingPivotTables:=True
    
13.     ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
    
14.         True, AllowFiltering:=True, AllowUsingPivotTables:=True
    
15.     ActiveSheet.Unprotect
    
16.    
    
17.     Dim arr, x%, n%, brr
    
18.     Dim aa
    
19.     aa = ActiveSheet.Range("b2:w2").Value
    
20.    
    
21.     arr = ActiveSheet.Range("a4:w" & Range("C65536").End(3).Row)
    
22.     '定义新表的列数
    
23.     ReDim brr(1 To UBound(arr), 1 To 22)
    
24.     For x = 1 To UBound(arr)
    
25.         If arr(x, 5) = "" Then Exit For
    
26.         If arr(x, 6) <> 0 Then
    
27.              n = n + 1
    
28.             brr(n, 1) = arr(x, 2)
    
29.             brr(n, 2) = arr(x, 3) '即姓名列
    
30.             brr(n, 3) = arr(x, 4)
    
31.             brr(n, 4) = arr(x, 5)
    
32.             brr(n, 5) = arr(x, 6)
    
33.             brr(n, 6) = arr(x, 7)
    
34.             brr(n, 7) = arr(x, 8)
    
35.             brr(n, 8) = arr(x, 9)
    
36.             brr(n, 9) = arr(x, 10)
    
37.             brr(n, 10) = arr(x, 11)
    
38.             brr(n, 11) = arr(x, 12)
    
39.             brr(n, 12) = arr(x, 13)
    
40.             brr(n, 13) = arr(x, 14)
    
41.             brr(n, 14) = arr(x, 15)
    
42.             brr(n, 15) = arr(x, 16)
    
43.             brr(n, 16) = arr(x, 17)
    
44.             brr(n, 17) = arr(x, 18)
    
45.             brr(n, 18) = arr(x, 19)
    
46.             brr(n, 19) = arr(x, 20)
    
47.             brr(n, 20) = arr(x, 21)
    
48.             brr(n, 21) = arr(x, 22)
    
49.             brr(n, 22) = arr(x, 23)
    
50.            
    
51.         End If
    
52.     Next
    
53.    
    
54.     Dim yf '创建变量
    
55.     Dim nf '创建变量
    
56.     yf = [g1] '=f1单元格的内容-月份
    
57.     nf = [e1] '年份=e1单元格的内容
    
58.    
    
59.     '查找并创建“个税测算”文件夹
    
60.     If Len(Dir("e:" & nf & "导出", vbDirectory)) < 1 Then
    
61.         MkDir "e:" & nf & "导出" '创建新文件夹
    
62.     End If
    
63.    
    
64.     '创建一个新工作簿
    
65.     Dim wb
    
66.     Set wb = Workbooks.Add
    
67.     With wb.Sheets(1)
    
68.         .Columns("D").NumberFormatLocal = "@"
    
69.         
    
70.         '表头各列对应的字段：
    
71.         .[a1:v1] = aa
    
72.         .[a2].Resize(n, 22) = brr
    
73.         .Columns("A:v").EntireColumn.AutoFit
    
74.         Range("a1:v" & Range("c65536").End(3).Row).Borders.LineStyle = 1
    
75.         
    
76.     End With
    
77.     wb.SaveAs "e:" & nf & "导出" & yf & "月初薪金-" & Format(Now(), "mmdd-hhmmss") & ".xlsx" '保存在“某年导出”文件夹中，文件名=d1+月+原表名+导出日期
    
78.     wb.Close
    
79.    
    
80.     MsgBox "OK，月初薪金已导出，并保存在“e:" & nf & "导出”文件夹中！", vbyesonly, "温馨提示"
    
81.    
    
82.     Application.ScreenUpdating = True '刷屏功能
    
83.     Application.DisplayAlerts = True '弹窗警示
    
84.    
    
85. End Sub

复制代码

hhxq001

caizhiliang 发表于 2021-3-28 16:04
这个很简单的  n=1   删了    把   n=n+1   放在判断后的第一行

什么道理呢

caizhiliang

hhxq001 发表于 2021-3-28 20:29
什么道理呢

你把n=n+1  放在最后一排   你的数组就会多出一行    因为  你提前设定了   n=1      其实提前设定n =1  是多余的    直接  在判断完  要写入数组时  开始计数就可以了