循序渐进VBA EXCEL数据操作小实例

标签：cleanup   vba   als   end   ksh   sum   add   value   put   1 向指定单元格区域内写入数据 Sub example1() Dim arr(1 To 3) arr(1) = Array("A", "B", "C", "D") arr(2) = Array("E", "F", "G", "H") arr(3) = Array("I", "J", "K", "L") For i = 1 To 3 Range("A" & i & ":D" & i).Value = arr(i) Next End Sub View Code 2 复制指定单元格内的数据到另一个区域 Sub example2() Dim arr1 arr1 = Range("A1:D1").Value Range("G3:J3").Value = arr1 End Sub View Code 3 数据操作综合实例 Sub example3() Dim i As Integer Dim Tit Tit = Array("正序列", "倒序") Sheet1.Range("O1:P1").Value = Tit For j = 1 To 24 Sheet1.Range("O" & j).Value = j Next Row = Sheet1.Range("o65536").End(xlUp).Row ‘读取数据行行号 r = r + Row For k = 1 To r Sheet1.Range("P" & k).Value = r r = r - 1 Next For i = 1 To Row arr2 = Sheet1.Range("O" & i & ":P" & i).Value ‘读取表一指定区域的单元格的值到数组 Sheets("Sheet1").Range("R" & i & ":S" & i).Value = arr2 ‘将数组的元素写入到表 Next End Sub View Code 4 Find 及 Findnext 全文查找综合实例 Sub example4() Dim s As String Dim c On Error Resume Next ‘Dim rn s = InputBox("输入查找关键字") i = 0 Set c = Sheets("sheet1").Range("a1:d65536").Find(s) If c Is Nothing Then i = 0 Else firstAddress = c.Address r = Sheet1.Range("a65536").End(xlUp).Row Do Set c = Sheet1.Range("a1:d" & r).FindNext(c) c.Interior.Color = RGB(232, 254, 250) i = i + 1 Loop While Not c Is Nothing And c.Address firstAddress End If MsgBox "共有" & i & "条满足条件的记录." End Sub View Code 5 添加数据及数据套打综合实例 Sub example5() rw = Sheet1.Range("a65536").End(xlUp).Row For i = 1 To rw arr = Sheet1.Range("a" & i & ":d" & i) With Sheet2 .Range("B2") = arr(1, 1) .Range("D2") = arr(1, 2) .Range("B3") = arr(1, 3) .Range("D3") = arr(1, 4) End With Call printForm ‘调用打印子程序 Next Call CleanUp ‘调用清除指定区域数据子程序 End Sub Sub CleanUp() ‘清除指定区域数据 With Sheet2 .Range("B2").ClearContents .Range("D2").ClearContents .Range("B3").ClearContents .Range("D3").ClearContents End With End Sub Sub printForm() ‘打印 Dim ws As Worksheet For Each ws In Worksheets If (ws.Visible = xlSheetVisible) And (ws.Name = "Sheet2") Then With ws.PageSetup .Zoom = False ‘关闭打印缩放 .FitToPagesWide = 1 ‘设置打印宽度 .FitToPagesTall = 1 ‘设置打印高度 End With ‘ws.PrintOut ws.PrintPreview End If Next End Sub Sub example6() ‘添加信息 Dim xm$, nl$, zy$, zn$ ‘声明数据类型为字符串 xm = Sheet2.Range("b2").Value nl = Sheet2.Range("d2").Value zy = Sheet2.Range("b3").Value zn = Sheet2.Range("d3").Value rw = Sheet3.Range("a65536").End(xlUp).Row If rw