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

解释Cells(Rows.Count, 5).End(3).Row

cells(Rows.count,2)表示B列的最大单元格数，在2003自动即为[B65536]，end(3),end属性，3表示XLUP，整个意思为B列所用的最大单元格，如B列用了8行，即cells(Rows.count,2).end(3).Row =8.

VBA代码编写中IF、Else判断语句的使用

网址：https://jingyan.baidu.com/article/fec4bce244ee02f2608d8b11.html

vba写入，检查构思思路：

单元格相同，跳过，继续，不同（包括没有数据）标注颜色，继续。

vba一个工具，表格拆分、合并、批量处理

网址：http://club.excelhome.net/thread-1309210-1-1.html

灵活拆分工具

网址：http://club.excelhome.net/thread-1317595-1-1.html

vba按列循环

For j = 1 To 10     '数据列

For k = 1 To 10     '数据行

jjj和iii也一样

网址：

http://blog.sina.cn/dpool/blog/s/blog_bf035a210102y6yx.html?md=gd