Excel 根据用户输入和跟踪结果填写特定列

我有一系列的产品，每季度例行测试，每种产品每年测试一次

我需要一个excel VBA，它会提示用户输入测试的产品，然后提示用户输入测试产品的季度（如第一季度、第二季度等）。然后在特定列中，显示产品测试的季度信息，并将其输入单元格

然后，我希望能够跟踪每个产品每年测试哪个季度的信息，因此对于每个产品的下一次测试，我希望excel填充它旁边的行。下面显示的是我试图实现的一个可视化示例

Excel工作表示例

另外附上的是代码，我一直试图适应我的问题

Dim myValue As Variant

myValue = InputBox("Give me some input")

Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet

' Set Search value
SearchString = myValue
Application.FindFormat.Clear
' loop through all sheets
For Each sh In ActiveWorkbook.Worksheets
   ' Find first instance on sheet
   Set cl = sh.Cells.Find(What:=SearchString, _
       After:=sh.Cells(1, 1), _
       LookIn:=xlValues, _
       LookAt:=xlPart, _
       SearchOrder:=xlByRows, _
       SearchDirection:=xlNext, _
       MatchCase:=False, _
       SearchFormat:=False)
   If Not cl Is Nothing Then
       ' if found, remember location
       FirstFound = cl.Address
       ' format found cell
       Do
           cl.Font.Bold = True
           cl.Interior.ColorIndex = 3
           ' find next instance
           Set cl = sh.Cells.FindNext(After:=cl)
           ' repeat until back where we started
       Loop Until FirstFound = cl.Address
   End If
Next
End Sub

---

在您的代码中，您有这一行来获取产品

myValue = InputBox("Give me some input")

只要再加一行就可以得到四分之一

myValue2 = InputBox("Give me some more input")

search命令工作正常，但可以通过将搜索限制在第一列而不是整个工作表来提高效率

Set cl = sh.Cells.Find(What:=SearchString, _
   After:=sh.Cells(1, 1), _
   LookIn:=xlValues, _
   LookAt:=xlPart, _
   SearchOrder:=xlByRows, _
   SearchDirection:=xlNext, _
   MatchCase:=False, _
   SearchFormat:=False)

要匹配整个字符串而不是部分，请更改参数LookAt:=xlother

如果只有一个产品与用户输入匹配，则可以删除此代码

Do
   cl.Font.Bold = True
   cl.Interior.ColorIndex = 3
   ' find next instance
   Set cl = sh.Cells.FindNext(After:=cl)
   ' repeat until back where we started
Loop Until FirstFound = cl.Address

行号只需使用

rowno = cl.Row

下一个您似乎有困难的部分是找到下一个可用的 该行中的空白列。VBA就像用户使用Ctrl-CursorLeft所做的那样 从结束列开始

colno = ws.range(rowno,Columns.count).End(xlToLeft.Column +1

因为你的工作表不太可能跨越702年，所以这可能更清楚

colno = ws.range("ZZ" & rowno).End(xlToLeft).Column + 1

现在更新该单元格

wc.cell(rowno,colno) = Value2

使用合理的变量名将这些组件组合在一起，对用户输入的内容添加一些验证，在关键点插入一些调试消息，您应该会得到类似的结果

  Sub enterdata()

      Const DBUG As Boolean = False ' set to TRUE to see each step
      Const YR1COL = 5 'E

      Dim wb As Workbook, ws As Worksheet
      Set wb = ThisWorkbook

      Dim sProduct As String
      Dim iRowno As Long, iQu As Integer, iColno As Integer
      Dim rng As Range, iLastRow As Long, wsMatch As Worksheet, cellMatch As Range
      Dim chances As Integer: chances = 3

  LOOP1:     ' get valid product
      sProduct = InputBox(Title:="Input Product", prompt:="Product is ")
      If DBUG Then Debug.Print sProduct

      If Len(sProduct) > 0 Then
          ' search  through all sheets
          For Each ws In wb.Sheets
              iLastRow = ws.Range("A" & ws.Rows.count).End(xlUp).Row
              If DBUG Then Debug.Print ws.Name & " " & iLastRow

              ' Search col A of sheet using xlWhole for exact match
              Set rng = ws.Range("A2:A" & iLastRow) ' avoid header
              Set cellMatch = rng.Find( _
                What:=sProduct, _
                After:=rng.Cells(2, 1), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False, _
                SearchFormat:=False)

              ' exit on first match
              If Not cellMatch Is Nothing Then
                  Set wsMatch = ws
                  GoTo LOOP2
              End If
          Next
      Else
          Exit Sub
      End If

      ' no match so try again
      If cellMatch Is Nothing Then
          chances = chances - 1
          If chances < 1 Then
              MsgBox "Too many tries", vbCritical, "Exiting"
              Exit Sub
          End If
          MsgBox sProduct & " NOT FOUND - " & chances & " tries left", vbExclamation, "Error"
          GoTo LOOP1
      End If

  LOOP2:

      iRowno = cellMatch.Row
      If DBUG Then Debug.Print wsMatch.Name & " Row = " & iRowno

      ' determine column
      With wsMatch
          iColno = .Cells(iRowno, Columns.count).End(xlToLeft).Column + 1
          If iColno < YR1COL Then iColno = YR1COL ' start in E
      End With

      wsMatch.Activate
      wsMatch.Cells(iRowno, iColno).Select
      If DBUG Then
          wsMatch.Cells(iRowno, iColno).Interior.ColorIndex = 6 ' yellow
          Debug.Print "Column = " & iColno
      End If
      If DBUG Then MsgBox "Target cell " & wsMatch.Name & " Row " & iRowno & " Col " & iColno, vbInformation

      chances = 3
  LOOP3: ' get valid QU
      iQu = Application.InputBox(Title:="Input Quarter", prompt:="Test Qu (1-4) for " & sProduct, Type:=1) ' type 1 number
      If iQu = 0 Then
         GoTo LOOP1
      ElseIf iQu > 4 Then
           chances = chances - 1
           If chances < 1 Then
               MsgBox "Too many tries", vbExclamation, "Error"
               Exit Sub
           End If
           MsgBox iQu & " NOT VALID - " & chances & " tries left", vbExclamation, "Error"
           GoTo LOOP3
      End If

      ' Update sheet
      wsMatch.Cells(iRowno, iColno) = iQu
      If DBUG Then wsMatch.Cells(iRowno, iColno).Interior.ColorIndex = 4 ' green
      MsgBox "Product=" & sProduct & vbCr _
         & wsMatch.Name & " Row=" & iRowno & " Col=" & iColno & " Qu=" & iQu, vbInformation, "Updated"

      GoTo LOOP1 ' next product

  End Sub

Sub-enterdata（）
Const DBUG As Boolean=False'设置为TRUE以查看每个步骤
常数YR1COL=5'E
将wb设置为工作簿，ws设置为工作表
设置wb=ThisWorkbook
作为字符串的Dim sProduct
Dim iRowno为长，iQu为整数，iColno为整数
Dim rng作为范围，iLastRow作为长度，wsMatch作为工作表，cellMatch作为范围
作为整数的暗淡几率：几率=3
循环1:'获取有效的产品
sProduct=输入框（标题：=“输入产品”，提示：=“产品是”）
如果是DBUG，则调试.打印sProduct
如果Len（sProduct）>0，则
'搜索所有工作表
对于wb.Sheets中的每个ws
iLastRow=ws.Range（“A”&ws.Rows.count）.End（xlUp）.Row
如果是DBUG，则Debug.Print ws.Name&“”&iLastRow
'使用xlWhole搜索工作表的列A以获得精确匹配
设置rng=ws.Range（“A2:A”&iLastRow）”避免标头
Set cellMatch=rng.Find（_
什么：=产品_
之后：=rng.单元（2，1）_
LookIn:=xlValues_
看：=xlother_
搜索顺序：=xlByRows_
SearchDirection:=xlNext_
MatchCase:=假_
SearchFormat:=False）
“第一场比赛就退出
如果不是，那么匹配就什么都不是了
设置wsMatch=ws
转到环路2
如果结束
下一个
其他的
出口接头
如果结束
'没有匹配，请重试
如果cellMatch算不了什么
机会=机会-1
如果几率小于1，则
MsgBox“尝试次数过多”，vbCritical，“正在退出”
出口接头
如果结束
MsgBox存储产品&“未找到-”&机会&“尝试左”，vb感叹号，“错误”
转到环路1
如果结束
循环2：
iRowno=cellMatch.Row
如果是DBUG，则Debug.Print wsMatch.Name&“Row=“&iRowno
'确定列
与wsMatch
iColno=.Cells（iRowno，Columns.count）.End（xlToLeft）.Column+1
如果iColno

您能解释一下您的实际问题是什么吗？代码是如何工作的？您的宏标识了正确的行，因此我想您需要帮助确定正确的列？每个产品的第1年、第2年是不同的还是固定的，例如第1年=2019年、第2年=2020年等等？@CDP1802您好，请注意，我的VBA技能非常基本。是的，宏识别正确的行，但我认为必须有更简单的宏来解决这个问题。每年都是固定的，例如产品A在2020年第三季度测试，然后在2021年第二季度测试，等等。你知道如何解决这个问题吗？谢谢。@BigBen您好，我的问题是提示用户输入测试内容，例如产品A，然后再次提示用户输入测试季度，然后每年输入下一次测试