VBA：查找日期并输入用户窗体文本框

Question

我有一个列表，VBA 需要在电子表格中查找日期以及机器名称，然后粘贴 UserForm 文本框。UserForm 可以工作，但它不会粘贴任何信息。我​​玩了几天，但不知道该如何让它工作。

主要表：

^{（点击图片放大）}

VBA运行结果：

如果有人需要下载完整的文件，工作文件位于 vbaexpress 论坛上。

Answer 1

看来你已经搞清楚了重点。我做了一些小改动，比如复制了问题，并将错误消息放在了if

Private Sub CommandButton1_Click()
Dim arr, Dat As Date, Mon$, rng As Range, mch As Range, mch1$, clm&, issue$
arr = Array("Januar", "Februar", "Mars", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Desember")
Dat = Sheets("Dayplan").Cells(r, 3)
mch1 = Sheets("Dayplan").Cells(r, 4)
issue = Sheets("Dayplan").Cells(r, 5)
Mon = arr(Month(Dat) - 1)

With Sheets(Mon)
    Set rng = .Rows(3).Find(Dat, lookat:=xlWhole)
    If Not rng Is Nothing Then
        Set mch = .Columns(1).Find(mch1, lookat:=xlWhole)
        If Not mch Is Nothing Then
            .Cells(mch.Row, rng.Column) = issue
            .Cells(mch.Row, rng.Column + 1) = TextBox1
            .Cells(mch.Row, rng.Column + 2) = Format(TextBox2, "dd-mm-yyyy")
            .Cells(mch.Row, rng.Column + 3) = TextBox3
        Else
            MsgBox "can not find machine"
        End If
    Else
        MsgBox "can not find date"
    End If
End With
Me.Hide

End Sub

或者，没有嵌套的 IF

With Sheets(Mon)
    Set rng = .Rows(3).Find(Dat, lookat:=xlWhole)
    Set mch = .Columns(1).Find(mch1, lookat:=xlWhole)
    If rng Is Nothing Then
        MsgBox "can not find date"
    ElseIf mch Is Nothing Then
        MsgBox "can not find machine"
    Else
        .Cells(mch.Row, rng.Column) = issue
        .Cells(mch.Row, rng.Column + 1) = TextBox1
        .Cells(mch.Row, rng.Column + 2) = Format(TextBox2, "dd-mm-yyyy")
        .Cells(mch.Row, rng.Column + 3) = TextBox3
    End If
End With

Answer 2

非常感谢 Christofer Weber

  .Cells(mch.Row, rng.Column + 1) = TextBox1
  .Cells(mch.Row, rng.Column + 2) = TextBox2 = Format("dd-mm-yyyy")
  .Cells(mch.Row, rng.Column + 3) = TextBox3

这有效，但我只得到 textbox2 的 UNTRUE / NOT TRUE （不确定英文 excel 说了什么）

我的文件在这里：14 天内可用

rushfiles.one/client/publiclink.aspx?id=VZEITMAxCi

选择右侧的箭头进行下载

格式不起作用，如何修复？

编辑，使这项工作：

  .Cells(mch.Row, rng.Column + 1) = TextBox1
   TextBox2.Value = Format(TextBox2.Value, "dd/mm/yyyy")
  .Cells(mch.Row, rng.Column + 2) = TextBox2
  .Cells(mch.Row, rng.Column + 3) = TextBox3

Answer 3

不知道为什么，但是当我复制你的代码时它不起作用，当我只复制你的部分代码并将其粘贴到我的代码中时它就起作用了。

无论如何，再次感谢，现在一切都很好，经过三天的谷歌搜索和在 12 个不同的论坛上发帖后，我感到非常高兴

以下是有效的代码：

Private Sub CommandButton1_Click()
Dim arr, Dat As Date, Mon$, rng As Range, mch As Range, mch1$, clm&
arr = Array("Januar", "Februar", "Mars", "April", "Mai", "Juni", "Juli", "August", 
"September", "Oktober", "November", "Desember")
Dat = Sheets("Dayplan").Cells(r, 3)
mch1 = Sheets("Dayplan").Cells(r, 4)
Mon = arr(Month(Dat) - 1)

With Sheets(Mon)
  Set rng = .Rows(3).Find(Dat, lookat:=xlWhole)
  If Not rng Is Nothing Then
    Set mch = .Columns(1).Find(mch1, lookat:=xlWhole)
    If Not mch Is Nothing Then

      .Cells(mch.Row, rng.Column + 1) = TextBox1
       TextBox2.Value = Format(TextBox2.Value, "dd/mm/yyyy")
      .Cells(mch.Row, rng.Column + 2) = TextBox2
      .Cells(mch.Row, rng.Column + 3) = TextBox3

        Else
            MsgBox "can not find machine"
    End If
    Else
        MsgBox "can not find date"
  End If
End With
Me.Hide
End Sub