Excel VBA使用用户输入跨多个工作表检查单元格并保存特定工作表以供以后使用

我是VBA新手，正在尝试用excel编写一个程序，它允许我手动将行和列输入到程序中。然后，程序应该在多个工作表中检查指定的单元格，看它是1还是0。如果它是0，那么我需要保存它所在的特定工作表，并在以后的输出框中进行标识

以下是我到目前为止的情况。我不确定的部分是保存指定的工作表，并指定用于从输入框检查的单元格，即Cj.rangeD H与Cj.cellDH等

Option Explicit
Sub Trial1()
Dim Hr As Single
Dim D As Single

Do
D = InputBox("Please enter the day you would like to study. Monday = A, Tuesday = B, Wed = C, Thurs = D, Fri = E, Sat = F, Sun = G.")
Hr = InputBox("Please enter the hour you would like to study in military time.")
If Hr >= 7 Or Hr <= 22 Then Exit Do
Loop
Call worksheet1()
End Sub

Sub worksheet1()

Dim Availability() As String
Dim C1 As Worksheet
Dim C2 As Worksheet
Dim C3 As Worksheet
Dim C4 As Worksheet
Dim C5 As Worksheet
Dim C6 As Worksheet
Dim C7 As Worksheet
Dim C8 As Worksheet
Dim C9 As Worksheet

Set C1 = ActiveWorkbook.Sheets("3043")
Set C2 = ActiveWorkbook.Sheets("2222")
Set C3 = ActiveWorkbook.Sheets("2205")
Set C4 = ActiveWorkbook.Sheets("3138")
Set C5 = ActiveWorkbook.Sheets("1011")
Set C6 = ActiveWorkbook.Sheets("1012")
Set C7 = ActiveWorkbook.Sheets("1016")
Set C8 = ActiveWorkbook.Sheets("1219")
Set C9 = ActiveWorkbook.Sheets("2245")

Do
For j = 1 To 9
    If Cj.Range(DHr) = 0 Then
        ReDim Preserve Availability(0 To UBound(Availability) + 1) As String
    End If
Next j

---

我认为您尝试使用工作簿名称进行的操作最好作为一个数组进行。虽然这不是一个完整的解决方案，但是还有其他问题，比如如果用户输入小写字母

Dim C(0 To 8) As String
Dim tRange As String
Dim tSheet As String

C(0) = "3043"
C(1) = "2222"
C(2) = "2205"
C(3) = "3138"
C(4) = "1011"
C(5) = "1012"
C(6) = "1016"
C(7) = "1219"
C(8) = "2245"

For j = 0 To 8
tSheet = C(j)     ' of course you can skip this line and just insert C(j) into Sheets()
tRange = Chr(34) & D & Hr & Chr(34)
    If Sheets(tSheet).Range(tRange) = 0 Then
        ReDim Preserve Availability(0 To UBound(Availability) + 1) As String
    End If
Next j

---

编辑：我在最后澄清了msgbox：要么没有可用的位置，要么就是恰好是工作表名称的“位置”列表

下面是一个示例，演示如何旋转所需的工作表，并找到在所需行/列中有零的工作表。您可以将列表传递回调用子例程，或者在找到它们的地方处理它

Option Explicit
Sub Trial1()
Dim Hr  As Long
Dim D   As Long

    Do
        D = InputBox("Please enter the day you would like to study. Monday = 1, Tuesday = 2, Wed = 3, Thurs = 4, Fri = 5, Sat = 6, Sun = 7.")
        Hr = InputBox("Please enter the hour you would like to study in military time.")
        If Hr >= 7 Or Hr <= 22 Then Exit Do
    Loop
    Call Check_Sheets(Hr, D)
End Sub

Function Check_Sheets(lRow As Long, lCol As Long)
Dim Availability()  As String
Dim i               As Integer
Dim ws              As Worksheet
Dim iAvail          As Integer
Dim strMSG          As String

' Note: I included the "'" as a delimiter in case the combined numbers give a false sheet name.
Const SheetNames = "'3043'2222'2205'3138'1011'1012'1016'1219'2245"

    For Each ws In ThisWorkbook.Sheets              ' Find all worksheets
        If InStr(1, SheetNames, "'" & ws.Name) > 0 Then     ' Is this a sheet we want?
            If ws.Cells(lRow, lCol).value & "" = 0 Then     ' Is the cell = 0 (warning: make sure no null values else!)
                iAvail = iAvail + 1                         ' Count as available
                ReDim Preserve Availability(iAvail)
                Availability(iAvail) = ws.Name              ' Save sheet name
            End If
        End If
    Next ws

    ' List Available Sheets
    If iAvail > 0 Then
        strMSG = "Area 1, 2 and 3 as saved in Array" & vbCrLf & vbCrLf     'This is the part I'm unsure about (TheBanks)
        For i = 1 To iAvail
            Debug.Print "Available: " & Availability(i)
            strMSG = strMSG & Availability(i) & vbCrLf
        Next
        MsgBox strMSG, vbOKOnly, "The Following Areas Are Available"
    Else
        MsgBox "There were NO places available", vbOKOnly, "None Available"
    End If
End Function

---

您可能希望在所有代码的顶部包含一个“Option Explicit”，以查看引用未定义变量的位置。返回一个字符串，其中包含满足条件的所有工作表名称，即“Sheet2，SheetA，Sheet5”，是否可以？是的，每个工作表都是不同的位置，行是一天中的时间，列是一周中的天。我需要该程序能够在给定/输入时间列出所有可用的工作表。我已经重命名了工作表，使其成为位置，并且我将每小时的块拆分为0或1，如果可用，则为0，如果不可用，则为1。您认为作为子程序、函数或两者都更好吗？您是否在询问如何将参数传递到函数或方法？而不是使用输入框？直接从另一个值传递它们，例如表单上的文本框或日期时间选择器？这个答案更多的是解决如何让变量控制工作表的问题。你可能正在寻找类似“Sub-UseNumbers X as Long，Y as Long”的东西，它需要X和Y，并以某种方式使用它们。然后你会叫它：'调用UseNumbers4，5'，或者如果它是一个函数，你会说'result=UseNumbers4，5'，我想这可能就是我要尝试改进程序的方式。我喜欢韦恩在上面发布的基地，但我想我会用X和Y的概念来比较两个不同的网站。如果我要这样做的话，我会比较两个不同的数组，按大小，忽略较小的X或Y。就像一个线性程序，最大化zeta=SummationX+SummationY，如果X>Y那么Y=0，如果Y>X那么X=0，这几乎正是我需要的。程序现在输出它正在搜索的特定行和列。我需要它在消息中输出单元格中包含0的工作表的特定名称。您看到显示的消息框了吗？如果有，是否有提及任何工作表名称？如果没有，则表示没有任何工作表将该单元格设置为0。显示了消息框，但它表示以下工作表在第11行第3列中有一个零。我需要它表示以下位置可用：工作表1、工作表4和工作表6或可用性数组存储工作表名称的任何内容。确定，我很困惑。现有消息框将列出所需单元格中零的“位置”或工作表名称。我更新了答案，说如果没有找到，请澄清。你是说你从未在messagebox中看到过“地点”列表？请尝试更新的代码，它将列出“地点”-如果找到任何。请让我知道结果-无或名称。我喜欢你为“未找到”添加的循环。现在的问题似乎是1Row和1Col正在保存行strMSG=上单元格的坐标，以下位置可用。应给出图纸名称，而不是重申给定坐标的零件。有了你添加的新循环，它一直在说没有地方可用，有时不应该。

Option Explicit
Sub Trial1()
Dim Hr  As Long
Dim D   As Long

    Do
        D = InputBox("Please enter the day you would like to study. Monday = 1, Tuesday = 2, Wed = 3, Thurs = 4, Fri = 5, Sat = 6, Sun = 7.")
        Hr = InputBox("Please enter the hour you would like to study in military time.")
        If Hr >= 7 Or Hr <= 22 Then Exit Do
    Loop
    Call Check_Sheets(Hr, D)
End Sub

Function Check_Sheets(lRow As Long, lCol As Long)
Dim Availability()  As String
Dim i               As Integer
Dim ws              As Worksheet
Dim iAvail          As Integer
Dim strMSG          As String

' Note: I included the "'" as a delimiter in case the combined numbers give a false sheet name.
Const SheetNames = "'3043'2222'2205'3138'1011'1012'1016'1219'2245"

    For Each ws In ThisWorkbook.Sheets              ' Find all worksheets
        If InStr(1, SheetNames, "'" & ws.Name) > 0 Then     ' Is this a sheet we want?
            If ws.Cells(lRow, lCol).value & "" = 0 Then     ' Is the cell = 0 (warning: make sure no null values else!)
                iAvail = iAvail + 1                         ' Count as available
                ReDim Preserve Availability(iAvail)
                Availability(iAvail) = ws.Name              ' Save sheet name
            End If
        End If
    Next ws

    ' List Available Sheets
    If iAvail > 0 Then
        strMSG = "Area 1, 2 and 3 as saved in Array" & vbCrLf & vbCrLf     'This is the part I'm unsure about (TheBanks)
        For i = 1 To iAvail
            Debug.Print "Available: " & Availability(i)
            strMSG = strMSG & Availability(i) & vbCrLf
        Next
        MsgBox strMSG, vbOKOnly, "The Following Areas Are Available"
    Else
        MsgBox "There were NO places available", vbOKOnly, "None Available"
    End If
End Function