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

浙公网安备 33010602011771号