excel - 如何将当前登录的用户的数据从数据表复制到目标表

Question

我想获取当前从数据表登录到目标表的用户的数据。

这是我为登录工作的代码：

Option Explicit

Function GetUserName() As String
    GetUserName = ThisWorkbook.Sheets("Login").Range("userName").Value
End Function

Function GetPassword() As String
    GetPassword = ThisWorkbook.Sheets("Login").Range("passWord").Value
End Function

Function IsValidUser(u As String, p As String) As Boolean
    Dim vu As Variant
    Set vu = ThisWorkbook.Sheets("Admin").Range("listOfUsers").Find(u)
    If Not vu Is Nothing And ThisWorkbook.Sheets("Admin").Cells(vu.Row, 
vu.Column + 1).Value = p Then IsValidUser = True Else IsValidUser = False
    Set vu = Nothing
End Function

Function IsLockedUser(u As String) As Boolean
    Dim vu As Variant
    Set vu = ThisWorkbook.Sheets("Admin").Range("listOfUsers").Find(u)
    If Not vu Is Nothing And ThisWorkbook.Sheets("Admin").Cells(vu.Row, 
vu.Column + 2).Value = 0 Then IsLockedUser = True Else IsLockedUser = False
    Set vu = Nothing
End Function

Function GetNoOfAttempt() As Integer
    GetNoOfAttempt = ThisWorkbook.Sheets("Login").Range("noOfAttempt").Value
End Function

Sub SetNoOfAttempt(a As Integer)
    ThisWorkbook.Sheets("Login").Range("noOfAttempt").Value = a
End Sub

Sub Login()
    On Error GoTo err
    Dim totAttempt As Integer
    totAttempt = GetNoOfAttempt

    If IsValidUser(GetUserName, GetPassword) Then
        If IsLockedUser(GetUserName) = False Then
        ThisWorkbook.Sheets("Input").Activate
    Else
        LockUser GetUserName
        MsgBox GetMessage("userLocked"), vbExclamation, "Locked"
    End If
Else
    SetNoOfAttempt totAttempt - 1
    If GetNoOfAttempt > 0 Then
        MsgBox GetMessage("msgLoginFailed"), vbExclamation, "Failed"
    Else
        MsgBox GetMessage("maxAttempt"), vbExclamation, "Failed"
    End If
End If
Exit Sub
err:
MsgBox err.Description, vbExclamation, "Error"
End Sub


Sub LockUser(u As String)
Dim vu As Variant
Set vu = ThisWorkbook.Sheets("Admin").Range("listOfUsers").Find(u)
If Not vu Is Nothing Then ThisWorkbook.Sheets("Admin").Cells(vu.Row, vu.Column + 2).Value = 0
Set vu = Nothing
End Sub

这是我正在使用的工作表：

数据表

目的地表

这个的目的是为了更新。因此，如果用户想要更改他们的数据，他们可以轻松地在目标工作表中进行更新。那么保存按钮应该会自动更新数据表上的数据。

标签： excelvba

Answer 1

我能够实现我想要的输出。我所做的只是创建一个新表，然后从数据表中获取与登录用户名相同的数据。然后将其粘贴到新表中。之后，我只是将新工作表中的单元格与目标工作表相等。

管理员 = 数据表

配置文件 = 目标表

合并 = 新工作表

这是代码：

Sub Transfer_Consolidated()

path = "Admin"

sql = ""
sql = sql & "Select [Username], [Password], '', [Security Question 1], 
[Answer 1], [Security Question 2], [Answer 2], [Security Question 3], 
[Answer 
3]"
sql = sql & "From [Admin$C26:K54]"
sql = sql & "Where [Username] = '" & Sheet1.Range("userName").Value & "'"

Sheet = "Consolidated" '(New Sheet)

LastRow = ThisWorkbook.Sheets("Admin").Range("A" & Rows.Count).End(xlUp).Row

Scrape path, sql, Sheet

Call Transfer_Profile

End Sub

Sub Transfer_Profile()


 Sheets("Profile").Range("E14").Value = _
 "=Consolidated!B2"

 Sheets("Profile").Range("E17").Value = _
 "=Consolidated!D2"

 Sheets("Profile").Range("E18").Value = _
 "=Consolidated!E2"

 Sheets("Profile").Range("E19").Value = _
 "=Consolidated!F2"

 Sheets("Profile").Range("E20").Value = _
 "=Consolidated!G2"

 Sheets("Profile").Range("E21").Value = _
 "=Consolidated!H2" '

 Sheets("Profile").Range("E21").Value = _
 "=Consolidated!H2"

 Sheets("Profile").Range("E22").Value = _
 "=Consolidated!I2"


End Sub