Question

如何编写“EXCEL VBA”程序？

Answer 1

Private Const DirPath$ = "C:\" '指向查找的路径
Sub aa()
Dim Filename$
Dim i&
Dim Wb As Workbook, Rng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
With Worksheets("总表")
For i = 1 To .[B65536].End(3).Row
If Len(.Cells(i, 2)) <> 0 Then
Filename = DirPath & "" & .Cells(i, "B") & ".xls"
If Len(Dir(Filename)) <> 0 Then
Set Wb = GetObject(Filename)
With Wb.Worksheets("材料")
If Err.Number <> 0 Then GoTo l
Set Rng = .[B:B].Find(what:="水泥砖")
If Not Rng Is Nothing Then
Worksheets("总表").Cells(i, "C") = Rng.Offset(0, 1).Value
End If
End With
l:
Wb.Close False
End If
End If
Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 2

Sub main()

Set dic = CreateObject("scripting.dictionary")

arr = Range("A1").CurrentRegion

For i = 1 To UBound(arr)

If dic.exists(arr(i, 2)) = False Then

dic(arr(i, 2)) = arr(i, 1)

Else

If dic(arr(i, 2)) < arr(i, 1) Then

dic.Remove arr(i, 2)

dic(arr(i, 2)) = arr(i, 1)

End If

End If

Next i

[E1].Resize(dic.Count, 1) = Application.Transpose(dic.keys)

[D1].Resize(dic.Count, 1) = Application.Transpose(dic.items)

End Sub

Answer 3

• 打开一个Excel文件，鼠标右击下面的工作表（如sheet1）。选择“查看代码”，就可以打开VBA编辑界面。

  

  

• 选择如下图所示的下拉菜单，选择“worksheet”。

  

• 选择如下图所示的下拉菜单，选择对应的触发模式。这里我们选择BeforeDoubleClick，意思就是说：在本工作表鼠标双击（之前），将触发下面的代码程序。（activate意思是说：在sheet表被选取的时候，就触发；Change意思是说：在这个模式下，只要sheet（工作表）发生变化，就将触发；Before Right Click是指在鼠标右击之前触发；SelectionChange是指在鼠标焦点发生变化时，触发。）

  

• 选择完成后，我们会看到下面出现了两条代码；这俩条代码其实是在声明一个函数。

  

• 将鼠标放置在这两行代码之间，我们写上执行语句：

  Sheet1.Cells(1, 3) = Sheet1.Cells(1, 1) + Sheet1.Cells(1, 2)

  其中：sheet1.cells（1,3）就是指第一行第三列的这个单元格；Sheet1.Cells(1, 1)就是指第一行第一列的这个单元格；Sheet1.Cells(1, 2)就是指第一行第二列的单元格。执行语句的意思是：将cells（1,1）和cells（1,2）的值相加，并赋值给cells（1,3）

  注意的是：写语句的时候，输入法一定要是输入字母的模式。要不然你的语句会报错。

  

• 然后点击保存，回到Excel的原始界面。在cells（1,1）和cells（1,2）中输入两个数值。（楼主输入的是：125895和78954）

  注意看：现在的cells（1,3）数值是空的。

  

• 在sheet1的工作表中，双击你的鼠标。你会发现，cells（1,3）的值变成了cells（1,1）和cells（1,2）的和。（204849=125895+78954）

  

Answer 4

Private Const DirPath$ = "C:\" '指向查找的路径
Sub aa()
Dim Filename$
Dim i&
Dim Wb As Workbook, Rng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
With Worksheets("总表")
For i = 1 To .[B65536].End(3).Row
If Len(.Cells(i, 2)) <> 0 Then
Filename = DirPath & "" & .Cells(i, "B") & ".xls"
If Len(Dir(Filename)) <> 0 Then
Set Wb = GetObject(Filename)
With Wb.Worksheets("材料")
If Err.Number <> 0 Then GoTo l
Set Rng = .[B:B].Find(what:="水泥砖")
If Not Rng Is Nothing Then
Worksheets("总表").Cells(i, "C") = Rng.Offset(0, 1).Value
End If
End With
l:
Wb.Close False
End If
End If
Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub