[已解决]如何把B列包含“工资”二字的各行数据提取出来生成新表

hhxq001 · 发表于 2021-3-6 16:17

本帖最后由 hhxq001 于 2021-3-6 16:58 编辑

怎么把B列中包含“工资”的各行人员的某些信息提取出来并另存为一个新的工作簿呢，请高手们指点。具体要导出的内容在“1月汇总”表的右上角

导出满足条件的人员信息0306.rar (961.05 KB, 下载次数: 30)

bridgeyao · 发表于 2021-3-7 07:48

能否达到要求？
Sub 提取工资()
Dim arr, x%, n%, brr
n = 1
arr = Sheets("1月汇总").Range("a7:z" & Sheets("1月汇总").[a65536].End(3).Row)
'身份证号4，姓名5，总收入18，住房公积金23，职业年金26，各数据在数组中的位置
ReDim brr(1 To UBound(arr), 1 To 5)
For x = 1 To UBound(arr)
If arr(x, 2) = "工资" Then
brr(n, 1) = arr(x, 5)
brr(n, 2) = arr(x, 4)
brr(n, 3) = arr(x, 18)
brr(n, 4) = arr(x, 23)
brr(n, 5) = arr(x, 26)
n = n + 1
End If
Next
Dim wb
Set wb = Workbooks.Add
With wb.Sheets(1)
.[a1:e1] = Array("姓名", "身份证号码", "总收入", "住房公积金", "职业年金")
.[a2].Resize(UBound(brr), UBound(brr, 2)) = brr
.Columns("A:E").EntireColumn.AutoFit
End With
End Sub

hhxq001 · 发表于 2021-3-7 10:35

本帖最后由 hhxq001 于 2021-3-7 11:08 编辑

bridgeyao 发表于 2021-3-7 07:48
能否达到要求？
Sub 提取工资()
Dim arr, x%, n%, brr

很不错的，谢谢，如果存为新文件后要求自己选择保存位置和名称，怎么改呢，文件名暂定为“1月工资数据”。另外，导出后身份证列为科学计数不符合身份证18位的格式。

bridgeyao · 发表于 2021-3-7 17:36

这个最佳答案由 bridgeyao 给出，感谢 bridgeyao 的回答。

单击隐藏图章

Sub 提取工资()
Dim arr, x%, n%, brr
n = 1
arr = Sheets("1月汇总").Range("a7:z" & Sheets("1月汇总").[a65536].End(3).Row)
'身份证号4，姓名5，总收入18，住房公积金23，职业年金26，各数据在数组中的位置
ReDim brr(1 To UBound(arr), 1 To 5)
For x = 1 To UBound(arr)
If arr(x, 2) = "工资" Then
      brr(n, 1) = arr(x, 5)
      brr(n, 2) = "'" & arr(x, 4)
      brr(n, 3) = arr(x, 18)
      brr(n, 4) = arr(x, 23)
      brr(n, 5) = arr(x, 26)
      n = n + 1
End If
Next
Dim wb
Set wb = Workbooks.Add
With wb.Sheets(1)
      .[a1:e1] = Array("姓名", "身份证号码", "总收入", "住房公积金", "职业年金")
      .[a2].Resize(UBound(brr), UBound(brr, 2)) = brr
      .Columns("A:E").EntireColumn.AutoFit
End With
wb.SaveAs Filename:="D:\2323.xlsx"
End Sub
身份证号前加个单引号可以转成文本格式，另存为的路径可以在代码中修改。

hhxq001 · 发表于 2021-3-8 21:43

本帖最后由 hhxq001 于 2021-3-8 22:36 编辑

bridgeyao 发表于 2021-3-7 17:36
Sub 提取工资()
Dim arr, x%, n%, brr
n = 1

1、如果想自由选择路径和文件名，怎么修改；2、如果是空表禁止导出，并提示“没有数据，禁止导出”，怎么添加

hhxq001 · 发表于 2021-3-9 22:31

bridgeyao 发表于 2021-3-7 17:36
Sub 提取工资()
Dim arr, x%, n%, brr
n = 1

麻烦给看看，下面的2个问题怎么解决哦

bridgeyao · 发表于 2021-3-10 12:31

参考
1，最简单路径名，可以存放在代码工作簿中某个sheet的单元格里，变量引用到代码中。
2，application.counta判断区域是否为空

315617070 · 发表于 2021-3-10 15:21

Application.FileDialog 解决问题1

hhxq001 · 发表于 2021-3-10 22:26

315617070 发表于 2021-3-10 15:21
Application.FileDialog 解决问题1

俺是小白，麻烦给修改下哦

hhxq001 · 发表于 2021-3-13 12:59

bridgeyao 发表于 2021-3-10 12:31
参考
1，最简单路径名，可以存放在代码工作簿中某个sheet的单元格里，变量引用到代码中。
2，application ...

自由选择路径的问题基本解决了。
现在的疑问是：如果提取的字段名称每个月都有变动，怎么处理呢？

		自动登录	找回密码
密码			注册

[已解决]如何把B列包含“工资”二字的各行数据提取出来生成新表

评分