想利用表一窗体输入数字到表格2内对应的列内（不是行）

lijie6

老师好！
      我想做个表格 要求是点击sheet1按钮后 在弹出窗体内表号位置下拉（支持模糊查询）选择表号或输入模糊数字选择要输入的表号后 自动在位置框带出对应位置，在日期栏自动显表格对应日期，在输入表数。点击确定按钮后（然后清空窗体，等待第二次输入），信息填写到sheet2表内对应列内。以后每月记录都会填写到C列、D列、F列……


      在窗体内输入的表号是不按表格2的顺序填写的。

3190496160

Private Sub ComboBox1_Change()
zd = ComboBox1.Text
r = Cells(Rows.Count, 1).End(xlUp).Row
ar = Range("a2:a" & r)
If Len(zd) = 6 Then
    Set rn = Range("a2:a" & r).Find(zd, , , , , , 1)
    w = rn.Row
    TextBox1.Text = Cells(w, 2)
    TextBox2.Text = Cells(w, 3)
Else
    Dim br()
    ReDim br(1 To UBound(ar), 1 To 1)
    For i = 1 To UBound(ar)
        If InStr(ar(i, 1), zd) > 0 Then
            n = n + 1
            br(n, 1) = ar(i, 1)
        End If
    Next i
    ListBox1.Visible = True
    ListBox1.List = br
End If
End Sub
Private Sub CommandButton1_Click()
rr = Array(ComboBox1.Text, TextBox1.Text, TextBox2.Text, TextBox3.Text)
For i = 0 To UBound(rr)
    If rr(i) = "" Then
        MsgBox "请把信息录入完整！": Exit Sub
    End If
Next i
Dim rn As Range, rng As Range
With Sheet2
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rn = .Rows(1).Find(CDate(TextBox2.Text), , , , , , 1)
    If rn Is Nothing Then MsgBox "表数工作表内没有" & TextBox2.Text: Exit Sub
    lh = rn.Column
    Set rng = .Range("a2:a" & r).Find(Val(ComboBox1.Text), , , , , , 1)
    If Not rng Is Nothing Then
        hh = rng.Row
    Else
        hh = r + 1
    End If
    If hh = 2 Then
        hh = 3
    Else
        hh = hh
    End If
    MsgBox hh
    .Cells(hh, 1) = ComboBox1.Text
    .Cells(hh, 2) = TextBox1.Text
    .Cells(hh, lh) = TextBox3.Text
End With
For i = 1 To 3
    Controls("TextBox" & i) = ""
Next i
ComboBox1.Text = ""
MsgBox "ok!"
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            zf = .List(i, 0)
            Exit For
        End If
    Next i
End With
If zf <> "" Then
    r = Cells(Rows.Count, 1).End(xlUp).Row
    Set rn = Range("a2:a" & r).Find(zf, , , , , , 1)
    w = rn.Row
    TextBox1.Text = Cells(w, 2)
    TextBox2.Text = Cells(w, 3)
    ComboBox1.Text = zf
    ListBox1.Visible = False
End If
End Sub
Private Sub UserForm_Initialize()
Dim r As Long, i As Long
r = Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "数据源为空！": Exit Sub
ar = Range("a2:a" & r)
ComboBox1.List = ar
ListBox1.Visible = False
End Sub

3190496160

示列.rar (30.25 KB, 下载次数: 4)

2025-1-15 09:56 上传

点击文件名下载附件

lijie6

3190496160 发表于 2025-1-15 09:56

老师你太厉害！非常感谢老师的帮助。