123
返回列表 上一主題 發帖

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

yliu

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

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2013-7-24 00:01 | 只看該作者

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

請問版上高手,
寫了一個VBA,要將一工作表上資料轉寫到另一工作表,結果都只有複製1筆資料,請幫忙看一下是哪裡有問題.
ListBox問題(2).zip (24.97 KB)
收藏 分享
learner

yliu

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

論壇贊助勳章
25#
發表於 2013-9-4 23:00 | 只看該作者
回復 24# GBKEE
感謝GBKEE, 改善原程式碼的缺點. 謝謝你的幫忙.
learner

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
24#
發表於 2013-9-4 11:13 | 只看該作者
回復 23# yliu
請修改如下
Dim lrow, irow, ai As Integer, AR(), S As String -> Dim  AR
If UBound(AR) > -1 Then ReDim    ->  If .ListCount > 0 Then ReDim
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

yliu

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

論壇贊助勳章
23#
發表於 2013-9-3 23:03 | 只看該作者
回復 22# GBKEE
GBKEE版大,
出現型態不符的錯誤訊息, 在AR = .List '.List-> ( 0 TO .ListCount - 1, 0 TO  9)   ListBox的ColumnCount 屬性 最多只能有 10 行 (0 到 9)。
learner

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
22#
發表於 2013-9-2 09:12 | 只看該作者
本帖最後由 GBKEE 於 2013-9-4 11:14 編輯

回復 12# yliu
  1. Private Sub ListBox2_Change()
  2.     Dim lrow, irow, ai As Integer, AR, S As String
  3.     With ListBox1
  4.         AR = .List  '.List-> ( 0 TO .ListCount - 1, 0 TO  9)   ListBox的ColumnCount 屬性 最多只能有 10 行 (0 到 9)。
  5.                     '這ListBox1只有4行資料,後面的5行-9行 = Null,使用Index 函數會錯誤
  6.         If .ListCount > 0 Then ReDim Preserve AR(0 To .ListCount - 1, 0 To .ColumnCount - 1)   '消除 後面的5行-9行的 Null
  7.         For lrow = 0 To .ListCount - 1
  8.             If .Selected(lrow) Then
  9.                 S = S & Join(Application.Index(AR, lrow + IIf(UBound(AR) = 0, 0, 1)), "")       '紀錄已勾選的資料
  10.             End If
  11.         Next
  12.         .Clear
  13.     End With
  14.     [A9:E19] = ""
  15.     With ListBox2
  16.         For lrow = 0 To .ListCount - 1
  17.             If .Selected(lrow) Then
  18.                 With Sheets(Sh)
  19.                     ai = 2
  20.                     Do While .Cells(ai, "A") <> ""
  21.                         If .Cells(ai, "A") = ListBox2.List(lrow, 0) Then
  22.                             With ListBox1
  23.                                 .AddItem
  24.                                 irow = .ListCount
  25.                                 .List(irow - 1, 0) = Sheets(Sh).Cells(ai, "A")
  26.                                 .List(irow - 1, 1) = Sheets(Sh).Cells(ai, "B")
  27.                                 .List(irow - 1, 2) = Sheets(Sh).Cells(ai, "C")
  28.                                 .List(irow - 1, 3) = Sheets(Sh).Cells(ai, "D")
  29.                                 .List(irow - 1, 4) = Sheets(Sh).Cells(ai, "E")
  30.                                 If InStr(S, Application.Phonetic(Sheets(Sh).Cells(ai, "A").Resize(, 5))) Then '比對: 紀錄已勾選的資料
  31.                                     .Selected(.ListCount - 1) = True
  32.                                 End If
  33.                             End With
  34.                         End If
  35.                         ai = ai + 1
  36.                     Loop
  37.                 End With
  38.             End If
  39.         Next
  40.     End With
  41. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
21#
發表於 2013-9-2 05:19 | 只看該作者
回復 20# yliu
如果妳將 MultiSelect:  - fmMultiSelectSingle 改成  fmMultiSelectMulti
如此 ListBox2 對應之 ListBox2_Change() 則將無任何作用，
是故你必須使用另外的方式來處理妳的勾選項，反之、
在每次勾選時都會觸動  ListBox2_Change() 。

TOP

yliu

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

論壇贊助勳章
20#
發表於 2013-9-1 23:13 | 只看該作者
回復 19# c_c_lai
抱歉, 依你所提供的,不是我要的複選. 我想應該是我表達的意思不夠清楚,
我要的複選如圖;
learner

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
19#
發表於 2013-8-30 15:23 | 只看該作者
回復  c_c_lai
不好意思, 現在無法上傳圖片, 只能先用文字敘述
我想只要用2個ListBox 完成選項, 太多物件 ...
yliu 發表於 2013-8-30 13:19


這便是你要的 (多選)

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
18#
發表於 2013-8-30 15:22 | 只看該作者
本帖最後由 c_c_lai 於 2013-8-30 15:25 編輯

回復 16# yliu
#17 樓是單選，你也可以改為多選：
  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.    
  5.     With Sheets("login")
  6.         單號 = .ListBox2.Value
  7.         Set Rng = .[B14:B24]
  8.         SS = Application.Phonetic(Rng)                               '  結合所有序號
  9.     End With
  10.    
  11.     With Sheets("final").[A:A]
  12.         If Application.CountIf(.Cells, 單號) > 1 Then
  13.             .Replace 單號, "=xxx", xlWhole                           '  Replace 方法
  14.             With .SpecialCells(xlCellTypeFormulas, xlErrors)
  15.                 .Cells = 單號
  16.                 For Each C In .Cells                                 '  比對到 序號 踢除 此序號
  17.                     If InStr(SS, C.Offset(, 1)) Then SS = Replace(SS, C.Offset(, 1), "") ' Replace 函數
  18.                     If SS = "" Then Exit Sub
  19.                 Next
  20.             End With
  21.         End If
  22.         
  23.         For Each E In Rng
  24.             If E = "" Then Exit For
  25.             
  26.             If InStr(SS, E) Then                                      '  比對到 序號
  27.                 g = Application.CountA(.Cells) + 1                    '  讀取A欗有資料數的儲存格數 +1
  28.                 i = Application.CountA(Rng)
  29.                
  30.                 .Cells(g, "A").Resize(1) = 單號
  31.                 .Cells(g, "B").Resize(1, 2) = E.Cells(1).Resize(1, 2).Value
  32.                 .Cells(g, "D").Resize(1, 6) = E.Cells(1, 4).Resize(1, 6).Value
  33.             End If
  34.         Next
  35.     End With
  36.    
  37.     With Sheets("login")
  38.         .ListBox1.Clear
  39.         .[A14:E24] = ""
  40.         .ListBox2 = ""
  41.     End With
  42. End Sub
複製代碼
增加最後五行 (37 ~ 41)。
  1. Private Sub ListBox2_Change()
  2.     Dim i As Integer, R As Integer
  3.    
  4.     '  ListBox1.Clear
  5.     Sheets("login").[A14:E24] = ""
  6.       
複製代碼
將 ListBox1.Clear Remark 起來。

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
17#
發表於 2013-8-30 14:43 | 只看該作者
回復 16# yliu
上頭附上的檔案是完全涵蓋你的 ListBox問題(2).zip 的需求，
原本是想讓你自己嘗試從中掘取出來，所以才會上傳圖片告訴你圈出的部分，
它是支很好的範例。想想還是把其它部分(案例)移除，取出你要的需求。

ListBoxes 複製資料轉寫到另一工作表.rar (42.64 KB)

TOP

        靜思自在 : 小事不做、大事難成。
123
返回列表 上一主題