日记首页V1.0


	日记首页 \| 列表 \| 添加日记 \| 管理登陆


	标题：vba代码备份，记录-周

vba代码备份记录-周课时输入窗体：Dim dPrivate Sub CommandButton1_Click() &nbsp;&nbsp;&nbsp; Call 清除当前所在位置的单元格 End Sub<hr>&nbsp;Private Sub CheckBox1_Change() &nbsp;&nbsp; Dim i&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '请假部分（复选框） &nbsp;&nbsp; With 课时输入窗体 &nbsp;&nbsp;&nbsp; For i = 1 To 5 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If .Controls("OptionButton" &amp; i).Value = True Then Exit For &nbsp;&nbsp;&nbsp;&nbsp; Next &nbsp;&nbsp;&nbsp;&nbsp; If i = 6 Then '初始状态 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextBox1 = IIf(.CheckBox1.Value, .CheckBox1.Caption, vbNullString) &nbsp;&nbsp;&nbsp;&nbsp; Else &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextBox1 = .Controls("OptionButton" &amp; i).Caption &amp; IIf(.CheckBox1.Value, .CheckBox1.Caption, vbNullString) &nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp; End With &nbsp;End Sub&nbsp;Private Sub OptionButton1_Click() &nbsp;&nbsp; Call CheckBox1_Change &nbsp;End Sub&nbsp;Private Sub OptionButton2_Click() &nbsp;&nbsp; Call CheckBox1_Change &nbsp;End Sub&nbsp;Private Sub OptionButton3_Click() &nbsp;&nbsp; Call CheckBox1_Change &nbsp;End Sub&nbsp;Private Sub OptionButton4_Click() &nbsp;&nbsp; Call CheckBox1_Change &nbsp;End Sub&nbsp;Private Sub OptionButton5_Click() &nbsp;&nbsp; Call CheckBox1_Change &nbsp;End Sub<hr>Private Sub 输入到指定行列_Click() &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; Dim i, j, nL%, nR% &nbsp;&nbsp;&nbsp; Dim cKc$, cXm$, xq$, cXq$, Arr() &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; cKc = Me.TextBox1.Value &nbsp;&nbsp;&nbsp; xq = ComboBox3.Value &nbsp;&nbsp;&nbsp; nR = d(ComboBox1.Value) '根据时间确定写入的行号 &nbsp;&nbsp;&nbsp; nL = d(xq) '列号 &nbsp;&nbsp;&nbsp; cXm = ComboBox2.Value &nbsp;&nbsp;&nbsp; If cKc = "" Or cXm = "" Or nR = 0 Or nL = 0 Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox ("没有对应数据") &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Sub &nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; With Sheets("Sheet1")&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '写入Sheet2中 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Arr = .Range("a2").Resize(1, nL + 3).Value &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = nL To nL + 3 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Arr(1, i) &lt;&gt; "" Then cXq = Arr(1, i) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If cXq = xq Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If .Cells(nR, i).Value = "" Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(nR, i).Value = cKc &amp; vbCrLf &amp; cXm &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(nR, i).Select&nbsp;&nbsp;&nbsp;&nbsp; '读取（单元格显示到屏幕中央? &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit For &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf .Cells(nR, i).Value = cKc &amp; vbCrLf &amp; cXm Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; i = nL + 3 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(nR, i).Select &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If i &gt; nL + 3 Then MsgBox ("已经有数据") &nbsp;&nbsp;&nbsp; End With End Sub<hr>Private Sub 输入到指定行列_3列_Click() &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; Dim i, j, nL%, nR% &nbsp;&nbsp;&nbsp; Dim cKc$, cXm$, xq$, Arr() &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; cKc = Me.TextBox1.Value &nbsp;&nbsp;&nbsp; xq = ComboBox3.Value &nbsp;&nbsp;&nbsp; nR = d(ComboBox1.Value) &nbsp;&nbsp;&nbsp; nL = d(xq) &nbsp;&nbsp;&nbsp; cXm = ComboBox2.Value &nbsp;&nbsp;&nbsp; If cKc = "" Or cXm = "" Or nR = 0 Or nL = 0 Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox ("没有对应数据") &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit Sub &nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; With Sheets("Sheet2") &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Arr = .Range("a2").Resize(1, nL + 2).Value &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = nL To nL + 2 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Arr(1, i) = xq Or Arr(1, i) = "" Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If .Cells(nR, i).Value = "" Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(nR, i).Value = cKc &amp; vbCrLf &amp; cXm &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(nR, i).Select&nbsp;&nbsp;&nbsp;&nbsp; '读取（单元格显示到屏幕中央） &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit For &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf .Cells(nR, i).Value = cKc &amp; vbCrLf &amp; cXm Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; i = nL + 2 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If i &gt; nL + 2 Then MsgBox ("已经有数据") &nbsp;&nbsp;&nbsp; End With End Sub<hr>&nbsp; Private Sub 输入到指定行列_自己写的_Click()&nbsp; Dim i, j &nbsp; Myr = Range("A65535").End(3).Row&nbsp;&nbsp;&nbsp; '逐行读取到最后一行 &nbsp;&nbsp; For i = 2 To Myr&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '文档第2行起，中截止到最后一行 &nbsp; 'For i = 2 To 100&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '要注意行数，文档中截止到35行 &nbsp;&nbsp;&nbsp; If ComboBox1.Value = Cells(i, 1) Then 'And TextBox1.Value = Cells(i, 4) Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For j = 2 To 15&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'j表示日期的列数，最多31列,从5开始1日 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If ComboBox3.Value = Cells(2, j) Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(i, j).Select&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '读取（单元格显示到屏幕中央） &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Len(Cells(i, j)) = 0 Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(i, j) = TextBox1.Value &amp; vbCrLf &amp; ComboBox2.Value: GoTo XX&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '第一列位置 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '[b7] = [b5] &amp; vbCrLf &amp; [b6] &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf Len(Cells(i, j)) &gt; 0 Then MsgBox ("已经有数据") &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ActiveCell.Offset(0, 1).Value = TextBox1.Value &amp; vbCrLf &amp; ComboBox2.Value: GoTo XX&nbsp;&nbsp; '第2列位置 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Len(ActiveCell.Offset(0, 1)) &gt; 0 Then MsgBox ("已经有数据，注意是否周日")&nbsp; '第3列位置 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ActiveCell.Offset(0, 2).Value = ComboBox2.Value &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'MsgBox ("ok") &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo XX &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit For &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next j &nbsp;&nbsp;&nbsp; End If &nbsp; Next i &nbsp; &nbsp; MsgBox ("没有对应数据") XX: End Sub<hr> Private Sub UserForm_Initialize() &nbsp;&nbsp;&nbsp; Dim Myr&amp;, i&amp;, nL% &nbsp;&nbsp;&nbsp; Dim brr, k &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; Set d = CreateObject("Scripting.Dictionary") &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Myr = Range("v65536").End(xlUp).Row&nbsp;&nbsp;&nbsp;&nbsp; '名字循环 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; brr = Range("v3:v" &amp; Myr).Value&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '名字循环 &nbsp;&nbsp;&nbsp; 'brr = Sheets("Sheet1").Range("V3:V30").Value &nbsp;&nbsp;&nbsp; Me.ComboBox2.List = brr &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp; With Sheets("Sheet1") &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; nL = .Range("xfd2").End(xlToLeft).Column &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; brr = .Range("a2").Resize(1, nL).Value &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 2 To nL &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If brr(1, i) &lt;&gt; "" Then &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Me.ComboBox3.AddItem brr(1, i) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(brr(1, i)) = i &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next &nbsp;&nbsp;&nbsp; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Myr = .Range("a65536").End(xlUp).Row &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; brr = .Range("a1:a" &amp; Myr).Value &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 3 To Myr &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If brr(i, 1) &lt;&gt; "" Then&nbsp; '加上这一句防止中间有空值 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(brr(i, 1)) = i &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Me.ComboBox1.AddItem brr(i, 1) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next&nbsp;&nbsp;&nbsp; End With'&nbsp;&nbsp;&nbsp; Set d = NothingEnd Sub