具有基于日期的可变行输入的Excel宏-Excelmacrowithvariablerowinputbasedondate

0  

I've written up a bit of code, this code assumes that Column A is dates in the format of "m/d/yyyy", Row 1 is a listing of the different birds you're traking via the sheet, and that you have Forms buttons on that same sheet with the name of the bird that matches what you have in Row 1 exactly. (e.g., C1 you have "Brown Wren", you then have a forms button that has "Brown Wren" as the text on it)

我写了一些代码,这段代码假设A列的格式是“m / d / yyyy”,第1行是你通过表单追踪的不同鸟类的列表,而你在同一张纸上有表单按钮,其名称与您在第1行中的名称完全匹配。 (例如,C1你有“Brown Wren”,然后你有一个表格按钮,上面有“Brown Wren”文字)

Option Explicit
Public ws As Worksheet

Private Sub AddBirdSighting(ByVal rng As Range)

    If rng Is Nothing Then
        Debug.Print "Invalid range"
        Exit Sub
    End If

    rng.Value = rng.Value + 1

End Sub

Private Function GetRange(ByVal Bird As String, ByVal Today As Date) As Range

    Dim c As Integer
    Dim r As Integer

    c = ws.Range("1:1").Find(Bird, LookIn:=xlValues).Column
    r = ws.Range("A:A").Find(Today, LookIn:=xlValues).Row

    Set GetRange = ws.Cells(r, c)

End Function

Public Sub CommandButtonClick()

    Set ws = ThisWorkbook.Sheets("Sheet1")

    Dim ctl As String
    Dim btn As String

    ctl = Application.Caller
    btn = ws.Buttons(ctl).Text

    AddBirdSighting GetRange(btn, Format(DateTime.Now, "m/d/yyyy"))

End Sub

Copy/paste this code into a module in VBA, and assign the CommandButtonClick procedure to all of the buttons. If you need any of this explained let me know and I'll go into more detail.

将此代码复制/粘贴到VBA中的模块中,并将CommandButtonClick过程分配给所有按钮。如果您需要任何解释,请告诉我,我会详细介绍。