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