VBA

建立一个excel表格,选中表单(sheet),右键=>"查看代码"
每个表单(sheet)都有各自独立的事件响应函数,可以自己去修改。
默认这些函数都是空的(即什么都不做),如果我们想做什么,则需要在
对应的函数体内添加响应的代码。
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
通常用的最多的函数是Worksheet_Change,当内容修改时做哪些动作。
Private Sub Worksheet_Change(ByVal Target As Range)
Msgbox "hello world!"
End Sub
当这个表单某个单元格内容变化时,就会弹出消息框"hello world!"
ByVal: 通过值传递
Target:是变量名
Range不是VB里面的数据类型,它是VBA(excel)里面的数据类型,表示一个单元格。

Range表示一个单元格或者一个区域,用法:
Range("a1", "b4").Select
Range("a2:b4").Select
Range("a1:b2,c3:d4").Select

Sub dxbn()
Dim rng As Range
Set rng = Worksheets("Sheet1").Range("A1")
rng.Value ="欢迎来到Excel Home论坛”
End sub

 

 

Worksheet.UsedRange
返回一个 Range 对象,该对象表示指定工作表上已经使用的区域(空白处不计算在内)。只读。
UsedRange属性应用于Worksheet对象,返回指定工作表中已使用区域的Range对象,即返回工作表中已使用的单元格区域。
表达式.UsedRange
表达式 一个代表 Worksheet 对象的变量。

 

这里举例修改某列时,自动根据修改的内容去sheet3中查找对应的列,并将相关的信息copy到本行。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 Then
        Target.Offset(0, -1) = Format(Now, "yyyy-mm-dd hh:mm:ss")
        Target.Offset(0, 1).Value = "aa"
        
        Dim c As Range
        Set c = Sheets("Sheet3").UsedRange.Columns(1).Find(Target.Text, lookat:=xlWhole) // 这个地方是1,表示被使用的单元格的第一列(C列)
        If Not c Is Nothing Then
            MsgBox "aaaa"
            c.Offset(0, 2).Resize(1, 1).Copy Target.Offset(0, 2)
            c.Offset(0, 4).Resize(1, 1).Copy Target.Offset(0, 3)
        End If
    End If
End Sub

sheet3:

   C       E     G
1234    x1    z1
1235    x2    z2
1236    x3    z3
1237    x4    z4

当在sheet1中B列填入数字时,会自动填充其他单元格

sheet1:

        A                       B      C      D    E
2018/2/2 10:30     1234    aa    x1    z1
2018/2/2 10:30     1237    aa    x4    z4
2018/2/2 10:30     1238    aa    x5    z5

 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 Then
        If Target = "" Then
            Target.Offset(0, -1) = ""
            Target.Offset(0, 1) = ""
            Target.Offset(0, 2) = ""
            Target.Offset(0, 3) = ""
        ElseIf Application.WorksheetFunction.CountIf(Columns(Target.Column), Target.Value) > 1 Then
            MsgBox ("重复录入,请重新输入")
            Target = ""
            Target.Offset(0, -1) = ""
        Else
            Target.Offset(0, -1) = Format(Now, "yyyy-mm-dd hh:mm:ss")
            Dim c As Range
            Set c = Sheets("Sheet3").UsedRange.Columns(25).Find(Target.Text, lookat:=xlWhole)
            If Not c Is Nothing Then
                c.Offset(, -18).Resize(1, 1).Copy Target.Offset(, 3)
                c.Offset(, -5).Resize(1, 1).Copy Target.Offset(, 2)
                
                If Target.Offset(, 2).Text = "华美宜修" Then
                    Target.Offset(, 2).Interior.Color = vbRed
                ElseIf Target.Offset(, 2).Text = "纯美间" Then
                    Target.Offset(, 2).Interior.Color = vbBlue
                Else
                    Target.Offset(, 2).Interior.Color = vbYellow
                End If
                    
                c.Offset(, 1).Resize(1, 1).Copy Target.Offset(, 1)
            End If
        End If
    ElseIf Target.Column = 6 And Target.Text = "已退款" Then
        Target.Offset(, -2).Interior.Color = vbWhite
    End If
End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "xx"
Dim a As Integer
a = Target.Column
MsgBox a
a = Target.Row
MsgBox a

For i = a To 65536
    If Sheets("Sheet3").Cells(i, 25).Value = "" Then
       Exit For
    End If
    
    MsgBox Sheets("Sheet3").Cells(i, 25).Text
    
    Dim c As Range
    Set c = Sheets("Sheet1").Columns(2).Find(Sheets("Sheet3").Cells(i, 25).Text, lookat:=xlWhole)
    If c Is Nothing Then
        For j = 1 To 65536
            If Sheets("Sheet1").Cells(j, 2).Value = "" Then
                Sheets("Sheet1").Cells(j, 1) = Format(Now, "yyyy-mm-dd hh:mm:ss")
                Sheets("Sheet1").Cells(j, 2) = Sheets("Sheet3").Cells(i, 25).Text
                Sheets("Sheet1").Cells(j, 3) = Sheets("Sheet3").Cells(i, 26).Text
                Sheets("Sheet1").Cells(j, 5) = Sheets("Sheet3").Cells(i, 7).Text
                Exit For
            End If
        Next
    End If
Next
End Sub

 

posted @ 2018-02-02 10:38  牧 天  阅读(619)  评论(0)    收藏  举报