vba，下拉菜单，去掉sheet后代码：

Private Sub UserForm_Initialize()
    Dim Myr&, i&
    Dim brr, d, k
    Set d = CreateObject("Scripting.Dictionary")
    Myr = Range("d65536").End(xlUp).Row
    brr = Range("c2:c" & Myr)
    For i = 1 To UBound(brr)
    If brr(i, 1) <> "" Then  '加上这一句防止中间有空值
        d(brr(i, 1)) = ""
        End If
    Next
    k = d.keys
    ComboBox1.List = k
    Set d = Nothing

End Sub

下拉菜单，指定sheet代码：

Private Sub UserForm_Initialize()
    Dim Myr&, i&, nL%       '下拉菜单部分（姓名，星期，时间）
    Dim brr, k
   
    Set d = CreateObject("Scripting.Dictionary")
   
        Myr = Range("v65536").End(xlUp).Row     '名字循环
        brr = Range("v3:v" & Myr).Value         '名字循环
    'brr = Sheets("Sheet1").Range("V3:V30").Value
    Me.ComboBox2.List = brr
   
    With Sheets("Sheet1")                    '星期循环
        nL = .Range("xfd2").End(xlToLeft).Column
        brr = .Range("a2").Resize(1, nL).Value
        For i = 2 To 20
            If brr(1, i) <> "" Then
                Me.ComboBox3.AddItem brr(1, i)
                d(brr(1, i)) = i
            End If
        Next
   
        Myr = .Range("a65536").End(xlUp).Row     '时间循环
        brr = .Range("a1:a" & Myr).Value
        For i = 3 To 22
            If brr(i, 1) <> "" Then  '加上这一句防止中间有空值
                d(brr(i, 1)) = i
                Me.ComboBox1.AddItem brr(i, 1)
            End If
        Next

    End With

'    Set d = Nothing

End Sub

1. vba，在查询课时时，删除掉其他行列，需要复原，如何实现

2. 现在用2套窗口（学生和老师），合并它

3. 在最后增加合计

4. 去掉sheet10,（不指定sheet，每页都可以用）

课程（记录-已确认）中，月输出无法正确写入，经查：在sheet1中V列W列发生变动，更改OK。

还要注意29行（日期）

要生成一个文件夹里边所有文件名的清单，其实也十分简单，我们只需要自制一个at批处理命令来生成文件名清单即可。操作方法步骤如下：

一、在其目录里新建一个txt文本文件；

第一种：

@ECHO OFF
tree /F > Ŀ¼.txt

第二种:

 @echo off
dir /b /on >list.txt

收集整理的书籍资源链接:https://pan.baidu.com/s/1slRxOoH密码: jkb7 文件解压密码：jingdukeji

电子书搜集加密打包 之 【MOBI】精品 链接: https://pan.baidu.com/s/1htqlWyC密码: n12s

各种精品RAR：链接: https://pan.baidu.com/s/1qZawAIg密码: 5jxq

拷贝方式：1）用 U~~ 线将设备连接电脑； 2）把书拷贝到如kindle的则是do开头的文件夹） 3）将书籍拷贝进去后，安全弹出设备； 4）PAPER 将自动导入书籍。 把链接复制到电脑浏览器上，进行下载哦，如果出现链接失效的情况尝试两种办法，换一个浏览器或者把杀毒软件关闭

vba代码备份

记录-周

课时输入窗体：

Dim d

Private Sub CommandButton1_Click()
    Call 清除当前所在位置的单元格
End Sub

 Private Sub CheckBox1_Change()
   Dim i                    '请假部分（复选框）
   With 课时输入窗体
    For i = 1 To 5
       If .Controls("OptionButton" & i).Value = True Then Exit For
     Next
     If i = 6 Then '初始状态
      .TextBox1 = IIf(.CheckBox1.Value, .CheckBox1.Caption, vbNullString)
     Else
       .TextBox1 = .Controls("OptionButton" & i).Caption & IIf(.CheckBox1.Value, .CheckBox1.Caption, vbNullString)
     End If
   End With
 End Sub

 Private Sub OptionButton1_Click()
   Call CheckBox1_Change
 End Sub

 Private Sub OptionButton2_Click()
   Call CheckBox1_Change
 End Sub

 Private Sub OptionButton3_Click()
   Call CheckBox1_Change
 End Sub

 Private Sub OptionButton4_Click()
   Call CheckBox1_Change
 End Sub

 Private Sub OptionButton5_Click()
   Call CheckBox1_Change
 End Sub

Private Sub 输入到指定行列_Click()
   
    Dim i, j, nL%, nR%
    Dim cKc$, cXm$, xq$, cXq$, Arr()
   
   
    cKc = Me.TextBox1.Value
    xq = ComboBox3.Value
    nR = d(ComboBox1.Value) '根据时间确定写入的行号
    nL = d(xq) '列号
    cXm = ComboBox2.Value
    If cKc = "" Or cXm = "" Or nR = 0 Or nL = 0 Then
        MsgBox ("没有对应数据")
        Exit Sub
    End If
   
    With Sheets("Sheet1")      '写入Sheet2中
        Arr = .Range("a2").Resize(1, nL + 3).Value
        For i = nL To nL + 3
            If Arr(1, i) <> "" Then cXq = Arr(1, i)
           
            If cXq = xq Then
                If .Cells(nR, i).Value = "" Then
                    .Cells(nR, i).Value = cKc & vbCrLf & cXm
                        Cells(nR, i).Select     '读取（单元格显示到屏幕中央?
                    Exit For
                ElseIf .Cells(nR, i).Value = cKc & vbCrLf & cXm Then
                    i = nL + 3
                End If
            End If
        Next
        Cells(nR, i).Select
        If i > nL + 3 Then MsgBox ("已经有数据")
    End With
End Sub

Private Sub 输入到指定行列_3列_Click()
   
    Dim i, j, nL%, nR%
    Dim cKc$, cXm$, xq$, Arr()
   
   
    cKc = Me.TextBox1.Value
    xq = ComboBox3.Value
    nR = d(ComboBox1.Value)
    nL = d(xq)
    cXm = ComboBox2.Value
    If cKc = "" Or cXm = "" Or nR = 0 Or nL = 0 Then
        MsgBox ("没有对应数据")
        Exit Sub
    End If
   
    With Sheets("Sheet2")
        Arr = .Range("a2").Resize(1, nL + 2).Value
        For i = nL To nL + 2
            If Arr(1, i) = xq Or Arr(1, i) = "" Then
                If .Cells(nR, i).Value = "" Then
                    .Cells(nR, i).Value = cKc & vbCrLf & cXm
                        Cells(nR, i).Select     '读取（单元格显示到屏幕中央）
                    Exit For
                ElseIf .Cells(nR, i).Value = cKc & vbCrLf & cXm Then
                    i = nL + 2
                End If
            End If
        Next
        If i > nL + 2 Then MsgBox ("已经有数据")
    End With
End Sub

  Private Sub 输入到指定行列_自己写的_Click()

  Dim i, j
  Myr = Range("A65535").End(3).Row    '逐行读取到最后一行
   For i = 2 To Myr          '文档第2行起，中截止到最后一行
  'For i = 2 To 100          '要注意行数，文档中截止到35行
    If ComboBox1.Value = Cells(i, 1) Then 'And TextBox1.Value = Cells(i, 4) Then
      For j = 2 To 15          'j表示日期的列数，最多31列,从5开始1日
        If ComboBox3.Value = Cells(2, j) Then
          Cells(i, j).Select        '读取（单元格显示到屏幕中央）
          If Len(Cells(i, j)) = 0 Then
          Cells(i, j) = TextBox1.Value & vbCrLf & ComboBox2.Value: GoTo XX        '第一列位置
         
          '[b7] = [b5] & vbCrLf & [b6]
         
          ElseIf Len(Cells(i, j)) > 0 Then MsgBox ("已经有数据")
          ActiveCell.Offset(0, 1).Value = TextBox1.Value & vbCrLf & ComboBox2.Value: GoTo XX   '第2列位置
            Else
          If Len(ActiveCell.Offset(0, 1)) > 0 Then MsgBox ("已经有数据，注意是否周日")  '第3列位置
          ActiveCell.Offset(0, 2).Value = ComboBox2.Value
         
          'MsgBox ("ok")
          GoTo XX
           Exit For
        End If
        End If
        'End If
      Next j
    End If
  Next i
 
  MsgBox ("没有对应数据")
XX:
End Sub

    End With

'    Set d = Nothing

End Sub

vba窗体工具箱控件介绍

网址：http://www.office68.com/excel/23957.html