显示存储在另一个工作表中的数据
Display data stored in another worksheet
有没有更好的方法（可行的方法？）
因此，我正在尝试创建一个小型数据库，工资管理员可以在其中存储打卡数据和工时数据，随着一周的进行，并将数据提交到输出 sheet，人力资源（也就是我）可以在其中上传工资数据。这是我第一次尝试自己构建一些东西 VBA 而不是仅仅从互联网上复制粘贴和编辑值。
我有一个工作sheet (Input_form) 就像一个用户表单，用于输入所有相关数据，我的想法是将用户写入的所有数据提交到我名册上的适当行 sheet (DoNotDelete_Source)，但首先我想显示已存储在那里的所有数据（例如之前输入的小时数，因此它们不会覆盖有效数据或花费时间输入已有的数据）。为此，他们将插入人员编号（ID 对人员唯一，但对行不唯一，因此会有一个依赖下拉列表，其中分配编号对行是唯一的），select 分配编号，然后单击“查找人员数据”按钮。
这个按钮是一个activex控件，代码如下：
Sub FindPersonsData()
Dim PN As Variant
Dim AN As Variant
Dim ws2 As Worksheet
Dim ws1 As Worksheet
Dim RowCalc As Range
Dim Source As Range
Set ws1 = Sheets("Input_Form")
Set ws2 = Sheets("DoNotDelete_Source")
PN = ws1.Range("Person_Num").Value
AN = ws1.Range("Assignment_Num").Value
Set Source = ws2.Range("Source")
Application.ScreenUpdating = False
For Each RowCalc In Source
''>>For every row in the source range
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Saturday" And ws2.Cells(1, 7) Like "Regular Hours" Then
''>>Check If Col A has the same person number, Col B has the same assignment number, Col E has the same WeekDay, and Col G has the same Element Name, and if it does then
ws1.Range("SatRegHr").Value = ws2.Cells(1, 8).Value
''>>Display the "regular hours" cell value for the row in correct cell in Input_Form
Else
ws1.Range("SatRegHr").Value = 0
''>>If there is no data for that day/element name, there are - hours for that day so display 0
End If
''>>move onto the next element name or day
''>>>>>>>>>>(Here is what I'm worried about: is this saying just to check if the first row matches all of that then set the hours value, but if not the to move on and not FIND THE ROW THAT MATCHES?)
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Saturday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("SatOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("SatOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Sunday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("SunRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("SunRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Sunday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("SunOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("SunOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Monday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("MonRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("MonRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Monday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("MonOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("MonOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Tuesday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("TueRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("TueRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Tuesday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("TueOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("TueOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Wednesday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("WedRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("WedRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Wednesday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("WedOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("WedOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Thursday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("ThuRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("ThuRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Thursday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("ThuOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("ThuOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Friday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("FriRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("FriRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Friday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("FriOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("FriOTHr").Value = 0
End If
Next RowCalc
Application.ScreenUpdating = True
End Sub
正在开始工作但是：
每次提交大约需要两分钟，我将此作为非 Excel 精明的薪资管理员的用户友好选项，因此我不希望他们被“无响应”屏幕吓到。
此外，更重要的是，结果全为零，而不是实际数据 - 不确定为什么 none 匹配，是 AND - LIKE 语句吗？
我还有大约 25 个部分要为其创建 If 语句，我相信这对速度没有帮助……谢谢！
现在我只是尝试在单击“显示人员数据”按钮时根据提供的值（人员编号）显示来自一个 sheet 的数据 - 就像索引匹配但是 VBA 和50 个不同的索引都基于不同的匹配标准（星期几、元素名称）。稍后我需要做相反的事情...（存储数据）。
如有任何想法，我们将不胜感激！非常感谢！
编辑：
这是输入表单 Sheet：https://imgur.com/a/WIwJteT
以及花名册 Sheet 的示例：https://imgur.com/a/Y420sEG
您逐个单元格读取的次数过多（尽管您发布的代码实际上只从第一行读取...当您尽可能少地点击 sheet 时，性能最佳。
已编译但未测试：
Sub FindPersonsData()
Dim PN As Variant
Dim AN As Variant
Dim ws2 As Worksheet
Dim ws1 As Worksheet
Dim RowCalc As Range
Dim Source As Range, arrDays, d, d3, rowDay, hrs
Set ws1 = Sheets("Input_Form")
Set ws2 = Sheets("DoNotDelete_Source")
PN = ws1.Range("Person_Num").Value
AN = ws1.Range("Assignment_Num").Value
Set Source = ws2.Range("Source")
arrDays = Array("Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday")
'set all cells to default zero hrs
For Each d In arrDays
d3 = Left(d, 3) 'short day name
ws1.Range(d3 & "RegHr").Value = 0
ws1.Range(d3 & "OTHr").Value = 0
Next d
'loop data and find any existing data
For Each RowCalc In Source.Rows 'must specify `Rows` here, otherwise it will be `Cells`
'no point in reading a bunch of cells if the first value match fails...
If RowCalc.Cells(1).Value = PN Then
If RowCalc.Cells(2).Value = AN Then
rowDay = RowCalc.Cells(5).Value
For Each d In arrDays
If rowDay = d Then
d3 = Left(d, 3)
hrs = RowCalc.Cells(8).Value
Select Case RowCalc.Cells(7).Value
Case "Regular Hours": ws1.Range(d3 & "RegHr").Value = hrs
Case "Overtime": ws1.Range(d3 & "OTHr").Value = hrs
End Select
End If
Next d
End If
End If
Next
End Sub
有没有更好的方法（可行的方法？） 因此，我正在尝试创建一个小型数据库，工资管理员可以在其中存储打卡数据和工时数据，随着一周的进行，并将数据提交到输出 sheet，人力资源（也就是我）可以在其中上传工资数据。这是我第一次尝试自己构建一些东西 VBA 而不是仅仅从互联网上复制粘贴和编辑值。 我有一个工作sheet (Input_form) 就像一个用户表单，用于输入所有相关数据，我的想法是将用户写入的所有数据提交到我名册上的适当行 sheet (DoNotDelete_Source)，但首先我想显示已存储在那里的所有数据（例如之前输入的小时数，因此它们不会覆盖有效数据或花费时间输入已有的数据）。为此，他们将插入人员编号（ID 对人员唯一，但对行不唯一，因此会有一个依赖下拉列表，其中分配编号对行是唯一的），select 分配编号，然后单击“查找人员数据”按钮。 这个按钮是一个activex控件，代码如下：
Sub FindPersonsData()
Dim PN As Variant
Dim AN As Variant
Dim ws2 As Worksheet
Dim ws1 As Worksheet
Dim RowCalc As Range
Dim Source As Range
Set ws1 = Sheets("Input_Form")
Set ws2 = Sheets("DoNotDelete_Source")
PN = ws1.Range("Person_Num").Value
AN = ws1.Range("Assignment_Num").Value
Set Source = ws2.Range("Source")
Application.ScreenUpdating = False
For Each RowCalc In Source
''>>For every row in the source range
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Saturday" And ws2.Cells(1, 7) Like "Regular Hours" Then
''>>Check If Col A has the same person number, Col B has the same assignment number, Col E has the same WeekDay, and Col G has the same Element Name, and if it does then
ws1.Range("SatRegHr").Value = ws2.Cells(1, 8).Value
''>>Display the "regular hours" cell value for the row in correct cell in Input_Form
Else
ws1.Range("SatRegHr").Value = 0
''>>If there is no data for that day/element name, there are - hours for that day so display 0
End If
''>>move onto the next element name or day
''>>>>>>>>>>(Here is what I'm worried about: is this saying just to check if the first row matches all of that then set the hours value, but if not the to move on and not FIND THE ROW THAT MATCHES?)
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Saturday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("SatOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("SatOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Sunday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("SunRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("SunRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Sunday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("SunOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("SunOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Monday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("MonRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("MonRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Monday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("MonOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("MonOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Tuesday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("TueRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("TueRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Tuesday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("TueOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("TueOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Wednesday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("WedRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("WedRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Wednesday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("WedOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("WedOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Thursday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("ThuRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("ThuRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Thursday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("ThuOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("ThuOTHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Friday" And ws2.Cells(1, 7) Like "Regular Hours" Then
ws1.Range("FriRegHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("FriRegHr").Value = 0
End If
If ws2.Cells(1, 1).Value Like PN And ws2.Cells(1, 2).Value Like AN And ws2.Cells(1, 5).Value Like "Friday" And ws2.Cells(1, 7) Like "Overtime" Then
ws1.Range("FriOTHr").Value = ws2.Cells(1, 8).Value
Else
ws1.Range("FriOTHr").Value = 0
End If
Next RowCalc
Application.ScreenUpdating = True
End Sub
正在开始工作但是：
每次提交大约需要两分钟，我将此作为非 Excel 精明的薪资管理员的用户友好选项，因此我不希望他们被“无响应”屏幕吓到。
此外，更重要的是，结果全为零，而不是实际数据 - 不确定为什么 none 匹配，是 AND - LIKE 语句吗？ 我还有大约 25 个部分要为其创建 If 语句，我相信这对速度没有帮助……谢谢！ 现在我只是尝试在单击“显示人员数据”按钮时根据提供的值（人员编号）显示来自一个 sheet 的数据 - 就像索引匹配但是 VBA 和50 个不同的索引都基于不同的匹配标准（星期几、元素名称）。稍后我需要做相反的事情...（存储数据）。
如有任何想法，我们将不胜感激！非常感谢！
编辑： 这是输入表单 Sheet：https://imgur.com/a/WIwJteT
以及花名册 Sheet 的示例：https://imgur.com/a/Y420sEG
您逐个单元格读取的次数过多（尽管您发布的代码实际上只从第一行读取...当您尽可能少地点击 sheet 时，性能最佳。
已编译但未测试：
Sub FindPersonsData()
Dim PN As Variant
Dim AN As Variant
Dim ws2 As Worksheet
Dim ws1 As Worksheet
Dim RowCalc As Range
Dim Source As Range, arrDays, d, d3, rowDay, hrs
Set ws1 = Sheets("Input_Form")
Set ws2 = Sheets("DoNotDelete_Source")
PN = ws1.Range("Person_Num").Value
AN = ws1.Range("Assignment_Num").Value
Set Source = ws2.Range("Source")
arrDays = Array("Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday")
'set all cells to default zero hrs
For Each d In arrDays
d3 = Left(d, 3) 'short day name
ws1.Range(d3 & "RegHr").Value = 0
ws1.Range(d3 & "OTHr").Value = 0
Next d
'loop data and find any existing data
For Each RowCalc In Source.Rows 'must specify `Rows` here, otherwise it will be `Cells`
'no point in reading a bunch of cells if the first value match fails...
If RowCalc.Cells(1).Value = PN Then
If RowCalc.Cells(2).Value = AN Then
rowDay = RowCalc.Cells(5).Value
For Each d In arrDays
If rowDay = d Then
d3 = Left(d, 3)
hrs = RowCalc.Cells(8).Value
Select Case RowCalc.Cells(7).Value
Case "Regular Hours": ws1.Range(d3 & "RegHr").Value = hrs
Case "Overtime": ws1.Range(d3 & "OTHr").Value = hrs
End Select
End If
Next d
End If
End If
Next
End Sub