VBA如何实现根据条件查找符合条件单元格并赋值

wlxzwxfx · 发表于 2024-1-25 16:51

请教各位老师，我想批量写入人员相关考勤记录，根据姓名时间查找后，并给单元格赋值。

feilanga · 发表于 2024-1-25 17:07

.....................

ykcbf1100 · 发表于 2024-1-25 17:33

参与一下。。。

Sub ykcbf() '//2024.1.25
Dim arr, d
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
r = .Cells(.Rows.Count, "a").End(xlUp).Row
arr = .[a1].Resize(r, 28)
End With
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
s = arr(i, 1) & "|" & arr(1, j)
d(s) = arr(i, j)
Next
Next
With Sheets("Sheet2")
r = .Cells(.Rows.Count, "a").End(xlUp).Row
arr = .[a1].Resize(r, 3)
For i = 2 To UBound(arr)
s = arr(i, 1) & "|" & arr(i, 2)
If d.Exists(s) Then
arr(i, 3) = d(s)
End If
Next
With .[a1].Resize(r, 3)
.Value = arr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

ykcbf1100 · 发表于 2024-1-25 17:34

附件供参考。。。

gwjkkkkk · 发表于 2024-1-25 18:52

Option Explicit
Sub TEST1()
Dim ar, br, i&, j&, k&

br = Sheets(1).[A1].CurrentRegion.Value
ar = [A1].CurrentRegion.Value
For i = 2 To UBound(ar)
      ar(i, 3) = Empty
      For k = 1 To UBound(br)
         If br(k, 1) = ar(i, 1) Then
            For j = 1 To UBound(br, 2)
                  If br(1, j) = ar(i, 2) Then
                        ar(i, 3) = br(k, j)
                     Exit For
                  End If
            Next j
            Exit For
         End If
      Next k
Next i
[A1].CurrentRegion.Value = ar
Beep
End Sub

gwjkkkkk · 发表于 2024-1-25 18:54

参与一下。。。

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

[求助] VBA如何实现根据条件查找符合条件单元格并赋值