【问题背景】
近期每天要远程打卡,每家公司打卡的数据会导出1张表,工作簿名为“A公司”,sheet1为当天已打卡名单。
要求根据原始的汇总名单(已在此表中)找出每家公司没打卡的人员。在工作簿名为“A公司”新建表格,然后把该公司要打卡所有员工信息贴进去,如未在sheet1中找到这个公司要打卡的人姓名,则I列表示N.A
【逻辑】
遍历文件夹中名称不等于自身的表格。
总名单表格为arr
新建的表格为arrnew ,基于公司名称相等。
【问题】
在用循环法给给arrnew数组赋值时候,
newarr(i,j)=arr(k,j)
arr(k,j)有数值,但arrnew=0,实在搞不懂为什么是0,然后即时窗口显示false
被这类问题困扰许久了,烦请各位高手帮忙看看,感激不尽~~~
注:数据中敏感信息已处理
(问题代码处)
原始的表格
要求跑完代码显示的样子
代码如下
Option Explicit
Sub text()
Dim sFName As String
Dim sFType As String
Dim sPath As String
Dim stra As String
'筛选公司
Dim stra1 '筛选公司
Dim wb
Dim rng
Dim arr()
Dim newarr(1 To 3000, 1 To 3000)
Dim k As Integer
Dim i As Integer, j As Integer
arr = Range("A1:I3000")
stra = "上海环境研究中心有限公司->环境中心-总经理办公室"
stra1 = Left(stra, InStr(stra, "-") - 1)
sFName = Dir("ThisWorkbook.Path" & "*.xlsx")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While sFName <> ""
If sFName <> ThisWorkbook.Name Then
Workbooks.Open (sFName)
ActiveWorkbook.Sheet (1)
End If
i = 1
j = 1
For k = 1 To 3000
For j = 1 To 8
k = 1
If arr(k, 9) = stra1 Then
newarr(i, j) = arr(k, j)
End If
Next j
i = i + 1
Next k
Debug.Print "newarr(i,j)" = newarr(i, j)
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "result"
Sheets("result").Select
Range("a1").Resize(2000, 8) = newarr
MsgBox "finish"
sFName = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub