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

yliu

請教高手,
如何將ListBox 清單內的資料寫入工作表上的儲存格,如圖,
選取序號001,002後,資料呈現於儲存格A9:E10.

下載 (45.06 KB)

2013-7-22 23:35

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

下載次數: 16

2013-7-22 23:35

Hsieh

回復 1# yliu

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

複製代碼

yliu

回復 2# Hsieh

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

yliu

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

下載 (89.38 KB)

2013-7-23 23:59

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

下載次數: 14

2013-7-24 00:00

GBKEE

回復 4# yliu

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

複製代碼

yliu

回復 5# GBKEE

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

GBKEE

回復 6# yliu

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

複製代碼

yliu

回復 7# GBKEE

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

yliu

回復 7# GBKEE

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

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

下載次數: 9

2013-8-2 00:05

GBKEE

回復 9# yliu

1. Private Sub CommandButton1_Click()
   
2.     Dim g As Integer, E As Range, C As Range, 單號 As String, SS As String, Rng As Range
   
3.     Dim i As Integer
   
4.     With Sheets("login")
   
5.         單號 = .ComboBox1.Value
   
6.         Set Rng = .[B9:B19]
   
7.         SS = Application.Phonetic(Rng)                                                  '結合所有序號
   
8.     End With
   
9.    
   
10.     With Sheets("final").[A:A]
    
11.         If Application.CountIf(.Cells, 單號) > 1 Then
    
12.             .Replace 單號, "=xxx", xlWhole                                               ''Replace 方法
    
13.             With .SpecialCells(xlCellTypeFormulas, xlErrors)
    
14.                 .Cells = 單號
    
15.                 For Each C In .Cells                                                     ''比對到 序號 踢除 此序號
    
16.                     If InStr(SS, C.Offset(, 1)) Then SS = Replace(SS, C.Offset(, 1), "") 'Replace 函數
    
17.                     If SS = "" Then Exit Sub
    
18.                 Next
    
19.             End With
    
20.         End If
    
21.         For Each E In Rng
    
22.             If E = "" Then Exit For
    
23.             If InStr(SS, E) Then                                              '比對到 序號
    
24.                 g = Application.CountA(.Cells) + 1                            '讀取A欗有資料數的儲存格數 +1
    
25.                 i = Application.CountA(Rng)
    
26.                 .Cells(g, "A").Resize(1) = 單號
    
27.                 .Cells(g, "B").Resize(1, 2) = E.Cells(1).Resize(1, 2).Value
    
28.                 .Cells(g, "D").Resize(1, 6) = E.Cells(1, 4).Resize(1, 6).Value
    
29.             End If
    
30.         Next
    
31.     End With
    
32. End Sub

複製代碼