stacey33的部落格

訂購網址：http://www.7net.com.tw/7net/rui005.faces?ID=120100154677&catid=13587&visit_chn=02&vid=ivip&mid=ivip_01&user=af000017132

EXCEL VBA．將指定值〔依序〕由上而下填入〔指定欄位〕中
　　　　　　　　　　　　　　　　　　　　　　　＜．准提部林．＞
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
■程式碼１：從Ａ１開始填起，須先檢測Ａ１是否為空格
　Sub 填入新值1()
　Dim xR As Range
　Set xR = [[Book2.xls]sheet1!A65536].End(xlUp)
　If xR <> "" Then Set xR = xR(2)
　xR = [A1]
　End Sub
　
■程式碼２：從Ａ２開始填起
　Sub 填入新值2()
　[[Book2.xls]sheet1!A65536].End(xlUp)(2) = [A1]
　End Sub
　
■程式碼３：預先檢測〔Book2〕是否開啟中，若否則〔提示〕之。
　Sub 填入新值3()
　Dim xBook As Workbook, xR As Range, Jm&
　For Each xBook In Workbooks
　　　If LCase(xBook.Name) = "book2.xls" Then Jm = 1: Exit For
　Next
　If Jm = 0 Then MsgBox "※目標檔案未開啟！　", 0 + 16: Exit Sub
　'LCase 將檔案名稱全轉為〔小寫〕再比對（檔名大小寫也視為相異） 　
　Set xR = xBook.Sheets("Sheet1").[A65536].End(xlUp)
　If xR <> "" Then Set xR = xR(2)
　xR = [A1]
　End Sub
　
■程式碼４：預先檢測〔Book2〕是否開啟中，若否則〔開啟〕之。
　Sub 填入新值4()
　Dim MyBook As Workbook, xBook As Workbook, xR As Range, Jm&
　Set MyBook = ThisWorkbook
　For Each xBook In Workbooks
　　　If LCase(xBook.Name) = "book2.xls" Then Jm = 1: Exit For
　Next
　If Jm = 0 Then
　　　If Dir(MyBook.Path & "\Book2.xls") = "" Then
　　　　　MsgBox "※目標檔案不存在！　", 0 + 16: Exit Sub
　　　End If
　　　Workbooks.Open MyBook.Path & "\Book2.xls"
　　　Set xBook = ActiveWorkbook
　　　MyBook.Activate
　End If
　Set xR = xBook.Sheets("Sheet1").[A65536].End(xlUp)
　If xR <> "" Then Set xR = xR(2)
　xR = [A1]
　End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－