我已经从A112:H206范围创建了一个表,其中星期几(星期日,星期一等)标题为B112-H112的表格行。在A栏中,我列出的个人名称一直到A206。
我在电子表格顶部有一个输入部分,用户将从单元格A109的下拉菜单中选择名称,一周从单元格B2中的下拉菜单,最后是单元格C109中的值,它应该输入到表格中的相应单元格中。
我创建了一个名为“Enter”的按钮,点击该按钮后,应根据上面的输入部分搜索相应的单元格,并在该单元格中输入C109值。不幸的是,我尝试使用VBA是不成功的!任何帮助将不胜感激。
谢谢!
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet
Dim x As Range
Dim y As Range
Dim valX, valY
Set ws1 = Sheets("Sheet1")
valX = ws1.Range("B2").Value
Set x = ws1.Range("A112:H112").Find(What:=valX, LookIn:=xlValues, _
lookat:=xlWhole)
If x Is Nothing Then
MsgBox "'" & valX & "' not found on '" & ws1.Name & "' !"
Exit Sub
End If
valY = ws1.Range("A109").Value
Set y = ws1.Range("A112:A206").Find(What:=valY, LookIn:=xlValues, _
lookat:=xlWhole)
If Not y Is Nothing Then
Range("C109").Select
Selection.Copy
ws1.Cells(x.Column, y.Row).Select
ActiveSheet.Paste
Range("C109").Select
Selection.ClearContents
Exit Sub
End If
End Sub
答案 0 :(得分:1)
我的一位朋友帮忙,我想在这里张贴,仅供其他人参考!
Range("C109").Select
Selection.Copy
Dim Day As String
Dim Name As String
Dim nameFound As Boolean
Dim dayFound As Boolean
Name = Cells(109, "A").Value
Day = Cells(2, "B").Value
Range("A113").Select
nameFound = False
Do Until IsEmpty(ActiveCell)
If ActiveCell.Value = Name Then
nameFound = True
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
If nameFound = True Then
Dim nameAddress As Integer
nameAddress = ActiveCell.Row
Else
MsgBox "Name not found"
End If
Range("B112").Select
dayFound = False
Do Until IsEmpty(ActiveCell)
If ActiveCell.Value = Day Then
dayFound = True
Exit Do
End If
ActiveCell.Offset(0, 1).Select
Loop
If dayFound = True Then
Dim dayAddress As Integer
dayAddress = ActiveCell.Column
Else
MsgBox "Day not found"
End If
Cells(nameAddress, dayAddress).Select
ActiveSheet.Paste
If ActiveCell.Column = 2 Or ActiveCell.Column = 4 Or ActiveCell.Column = 6 Or ActiveCell.Column = 8 Then
ActiveCell.Interior.Color = RGB(83, 142, 213)
ElseIf ActiveCell.Column = 3 Or ActiveCell.Column = 5 Or ActiveCell.Column = 7 Then
ActiveCell.Interior.Color = RGB(182, 221, 232)
End If
Range("C109").Select
Selection.ClearContents
答案 1 :(得分:0)
未测试:
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet
Dim x As Range
Dim y As Range
Dim valX, valY
Set ws1 = Sheets("Sheet1")
valX = ws1.Range("A109").Value
Set x = ws1.Range("A112:H112").Find(What:=valX, LookIn:=xlValues, _
lookat:=xlWhole)
If x Is Nothing Then
MsgBox "'" & valX & "' not found on '" & ws1.Name & "' !"
Exit Sub
End If
valY = ws1.Range("B2").Value
Set y = ws1.Range("A112:A206").Find(What:=valY,LookIn:=xlValues, _
lookat:=xlWhole)
If Not y Is Nothing Then
With ws1.Range("C109")
.Copy ws1.Cells(y.Row, x.Column)' <<EDITED
.ClearContents
End With
Else
MsgBox "Name '" & valY & "' not found on '" & ws1.Name & "' !"
End If
End Sub