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

2 復制指定單元格內的數據到另一個區域

Sub
 
 example2()
    Dim arr1
    arr1 = Range("A1:D1").Value
    Range("G3:J3").Value = arr1
End Sub

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

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

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 < 1 Then rw = 1: End
    i = rw + 1
    
    With Sheet3
        .Cells(i, 1) = xm
        .Cells(i, 2) = nl
        .Cells(i, 3) = zy
        .Cells(i, 4) = zn
    End With
    
    i = i + 1
    Call CleanUp
End Sub

循序漸進VBA EXCEL數據操作小實例