帖子: 103
主題: 30
精華: 0
積分: 139
點名: 0
作業系統: wondows XP
軟體版本: office 2007
閱讀權限: 20
性別: 男
來自: 彰化
註冊時間: 2013-2-21
最後登錄: 2015-6-26

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2013-2-21 15:34 | 只看該作者

[發問] VBA 如何新增下一筆資料

想請問各位VBA高手，小弟我是最近開始研究VBA程式
目前是想要撰寫在能Excel表單內新增一筆資料後
會一直往下新增
目前小弟寫的程式如下
但每寫入一筆資料後就會刪除前一筆資料
欄位不曉得如何往下新增?
===================================
Sub 陣列新增資料()
Dim a(18)
Sheets("空白需求單").Select
a(0) = Range("B29") '編號
a(1) = Range("A1") '需求項目
a(2) = Range("B2") '子項目
a(3) = Range("B3") '委託單位
a(4) = Range("B4") '委託人
a(5) = Range("B5") '委託項目
a(6) = Range("D4") '連絡方式
a(7) = Range("F3") '委託日
a(8) = Range("F4") '目標完成日
a(9) = Range("F5") '實際完成日
a(10) = Range("B6") '案件緣由
a(11) = Range("B8") '製作方式
a(12) = Range("B11:B13") '必備項目
a(13) = Range("B14") '回饋項目
a(14) = Range("C16:C18") '回饋格式
a(15) = Range("B20") '製作順序
a(16) = Range("B22") '資料位置
a(17) = Range("B24") '後續追蹤
a(18) = Range("B26") '備註

Sheets("線上總表").Select
Range("S3") = a(0) '編號
Range("A3") = a(1) '需求項目
Range("B3") = a(2) '子項目
Range("C3") = a(3) '委託單位
Range("D3") = a(4) '委託人
Range("E3") = a(5) '聯絡方式
Range("F3") = a(6) '連絡方式
Range("G3") = a(7) '委託時間
Range("H3") = a(8) '目標完成時間
Range("I3") = a(9) '實際完成時間
Range("J3") = a(10) '案件緣由
Range("K3") = a(11) '製作方式
Range("L3") = a(12) '必要項目
Range("M3") = a(13) '回饋項目
Range("N3") = a(14) '回饋格式
Range("O3") = a(15) '製作順序
Range("P3") = a(16) '檔案路徑
Range("Q3") = a(17) '後續追蹤
Range("R3") = a(18) '備註

Sheets("空白需求單").Select
Range("A1,B2,B3,B4,B5,D4,F3,F4,F5,B6,B8,B11:B13,B14,C16:C18,B20,B22,B24,B26").Select
Selection.ClearContents '新增完一筆後會刪除表單內的資料並將編號+1

Range("B29").Formula = "=Text(" & a(0) + 1 & ",""0000"")"

End Sub
==========================================================

樓主熱帖

Jared

中學生 Rank: 2

帖子: 103
主題: 30
精華: 0
積分: 139
點名: 0
作業系統: wondows XP
軟體版本: office 2007
閱讀權限: 20
性別: 男
來自: 彰化
註冊時間: 2013-2-21
最後登錄: 2015-6-26

5^#

發表於 2013-2-23 10:50 | 只看該作者

謝謝 Hsieh
馬上來試看看~

Jared

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 247
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-14

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2013-2-22 16:54 | 只看該作者

回復 3# Jared
沒有檔案，猜猜你的需求

Sub 陣列新增資料()
Dim a(1 To 19)
With Sheets("空白需求單")
a(1) = .Range("A1") '需求項目
a(2) = .Range("B2") '子項目
a(3) = .Range("B3") '委託單位
a(4) = .Range("B4") '委託人
a(5) = .Range("B5") '委託項目
a(6) = .Range("D4") '連絡方式
a(7) = .Range("F3") '委託日
a(8) = .Range("F4") '目標完成日
a(9) = .Range("F5") '實際完成日
a(10) = .Range("B6") '案件緣由
a(11) = .Range("B8") '製作方式
a(12) = Join(Application.Transpose(.Range("B11:B13")), "、") '必備項目
a(13) = .Range("B14") '回饋項目
a(14) = Join(Application.Transpose(.Range("C16:C18")), "、") '回饋格式
a(15) = .Range("B20") '製作順序
a(16) = .Range("B22") '資料位置
a(17) = .Range("B24") '後續追蹤
a(18) = .Range("B26") '備註
a(19) = .Range("B29") '編號
With Sheets("線上總表")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 19) = a
End With
.Range("A1,B2,B3,B4,B5,D4,F3,F4,F5,B6,B8,B11:B13,B14,C16:C18,B20,B22,B24,B26").ClearContents '新增完一筆後會刪除表單內的資料並將編號+1
.Range("B29").Formula = "=Text(" & a(19) + 1 & ",""0000"")"
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

Jared

中學生 Rank: 2

帖子: 103
主題: 30
精華: 0
積分: 139
點名: 0
作業系統: wondows XP
軟體版本: office 2007
閱讀權限: 20
性別: 男
來自: 彰化
註冊時間: 2013-2-21
最後登錄: 2015-6-26

3^#

發表於 2013-2-22 14:57 | 只看該作者

你好!
a(12) = Range("B11:B13") '必備項目
a(14) = Range("C16:C18") '回饋格式

B11、B12、B13是連續欄位
是一塊儲存在另外一個欄位

Jared

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 247
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-14

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2013-2-21 16:01 | 只看該作者

本帖最後由 Hsieh 於 2013-2-21 16:03 編輯

回復 1# Jared
a(12) = Range("B11:B13") '必備項目
a(14) = Range("C16:C18") '回饋格式
此2個項目是合併儲存格嗎?
最好上傳檔案說明

學海無涯_不恥下問

TOP