根据行和列标题选择单元格,并从该工作表上的输入节输入值

时间:2014-02-07 21:41:03

标签: excel vba

我已经从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

2 个答案:

答案 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