[發問] 複製資料轉寫到另一工作表

Hsieh

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

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

2^#

發表於 2013-7-23 09:34 | 只看該作者

回復 1# yliu

Private Sub ListBox1_Change()
Dim ar()
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
ReDim Preserve ar(s)
ar(s) = Array(i + 1, .List(i, 0), .List(i, 1), .List(i, 2), .List(i, 3))
s = s + 1
End If
Next
End With
[A9:E19] = ""
If s > 0 Then [A9].Resize(s, 5) = Application.Transpose(Application.Transpose(ar))
End Sub

複製代碼

學海無涯_不恥下問

yliu

帖子: 49
主題: 8
精華: 0
積分: 63
點名: 0
作業系統: windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 女
來自: 高雄
註冊時間: 2013-4-8
最後登錄: 2013-10-30

論壇贊助勳章

3^#

發表於 2013-7-23 20:37 | 只看該作者

回復 2# Hsieh

感謝Hsieh版大的幫忙，可以使用了，謝謝！

learner

yliu

帖子: 49
主題: 8
精華: 0
積分: 63
點名: 0
作業系統: windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 女
來自: 高雄
註冊時間: 2013-4-8
最後登錄: 2013-10-30

論壇贊助勳章

4^# 倒序看帖

打印

字體大小: tT

發表於 2013-7-24 00:01 | 只看該作者

[發問] 複製資料轉寫到另一工作表

請問版上高手,
寫了一個VBA,要將一工作表上資料轉寫到另一工作表,結果都只有複製1筆資料,請幫忙看一下是哪裡有問題.

ListBox問題(2).zip (24.97 KB)

learner

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2013-7-24 07:24 | 只看該作者

回復 4# yliu

Private Sub CommandButton1_Click()
Dim rowcnt&, rowcnt_login&
Dim g As Integer, 序號 As Range, I As Integer
Set 序號 = Sheets("login").[B9:J19] '物件 : 設定複製的範圍
g = Application.CountA(Sheets("final").[A:A]) + 1 '讀取A欗有資料數的儲存格數 +1
I = 1
Do Until 序號.Range("A" & I) = "" Or I > 序號.Rows.Count
'範圍的 Range("A" & I)->範圍的"A"欗 ,Rows.Count;範圍列數的計算
With Sheets("final")
.Cells(g, "A") = Sheets("login").ComboBox1.Value
.Cells(g, "B").Resize(1, 序號.Columns.Count) = 序號.Rows(I).Value
g = g + 1
I = I + 1
End With
Loop
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

yliu

帖子: 49
主題: 8
精華: 0
積分: 63
點名: 0
作業系統: windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 女
來自: 高雄
註冊時間: 2013-4-8
最後登錄: 2013-10-30

論壇贊助勳章

6^#

發表於 2013-7-24 17:39 | 只看該作者

回復 5# GBKEE

GBKEE你好,
請問若複製範圍不是連續範圍時, 該怎麼做?
例如: 目的地工作表”final”的C欄『規格』刪除, 來源工作表是連續範圍, 但目的地工作表不是連續範圍時.

learner

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

7^#

發表於 2013-7-24 20:10 | 只看該作者

回復 6# yliu

Private Sub CommandButton1_Click()
Dim g As Integer, E As Range
g = Application.CountA(Sheets("final").[A:A]) + 1 '讀取A欗有資料數的儲存格數 +1
For Each E In Sheets("login").[B9:B19]
If E = "" Then Exit For
With Sheets("final")
.Cells(g, "A") = Sheets("login").ComboBox1.Value
.Cells(g, "B").Resize(1, 2) = E.Resize(1, 2).Value
.Cells(g, "D").Resize(1, 6) = E.Cells(1, 4).Resize(1, 6).Value
End With
g = g + 1
Next
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

yliu

帖子: 49
主題: 8
精華: 0
積分: 63
點名: 0
作業系統: windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 女
來自: 高雄
註冊時間: 2013-4-8
最後登錄: 2013-10-30

論壇贊助勳章

8^#

發表於 2013-7-24 23:33 | 只看該作者

回復 7# GBKEE

真的很謝謝GBKEE, 以及上次幫忙的Hsieh.
想藉由Excel VBA來解決工作上一些繁瑣的資料處理,但我只學過基本的VBA, 功力實在不足,
感激版主們無私的解答,讓我解決工作上問題.

learner

yliu

帖子: 49
主題: 8
精華: 0
積分: 63
點名: 0
作業系統: windows XP
軟體版本: Office 2003
閱讀權限: 20
性別: 女
來自: 高雄
註冊時間: 2013-4-8
最後登錄: 2013-10-30

論壇贊助勳章

9^#

發表於 2013-8-2 00:05 | 只看該作者

回復 7# GBKEE

GBKEE版大,
延伸另一個問題, 使用ListBox ,請問如何讓已選取且已COPY到工作表"final"的單號&序號不會再次被選取COPY?

ListBox問題(2).zip (26.2 KB)

learner

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

10^#

發表於 2013-8-3 14:20 | 只看該作者

回復 9# yliu

Private Sub CommandButton1_Click()
Dim g As Integer, E As Range, C As Range, 單號 As String, SS As String, Rng As Range
Dim i As Integer
With Sheets("login")
單號 = .ComboBox1.Value
Set Rng = .[B9:B19]
SS = Application.Phonetic(Rng) '結合所有序號
End With
With Sheets("final").[A:A]
If Application.CountIf(.Cells, 單號) > 1 Then
.Replace 單號, "=xxx", xlWhole ''Replace 方法
With .SpecialCells(xlCellTypeFormulas, xlErrors)
.Cells = 單號
For Each C In .Cells ''比對到序號踢除此序號
If InStr(SS, C.Offset(, 1)) Then SS = Replace(SS, C.Offset(, 1), "") 'Replace 函數
If SS = "" Then Exit Sub
Next
End With
End If
For Each E In Rng
If E = "" Then Exit For
If InStr(SS, E) Then '比對到序號
g = Application.CountA(.Cells) + 1 '讀取A欗有資料數的儲存格數 +1
i = Application.CountA(Rng)
.Cells(g, "A").Resize(1) = 單號
.Cells(g, "B").Resize(1, 2) = E.Cells(1).Resize(1, 2).Value
.Cells(g, "D").Resize(1, 6) = E.Cells(1, 4).Resize(1, 6).Value
End If
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.