返回列表 上一主題 發帖

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

回復 12# yliu
套用你原本的檔案,並加以稍稍修改,看看是否符合你的需求。
請觀察 ThisWorkbook 與 Sheet1 (login) 間之互動。
P.S.  另額外增加了 Checkbox 的應用,供參考。
ListBox 複製資料轉寫到另一工作表.rar (41.65 KB)

TOP

回復 14# yliu
你要的是 圈起來的部分,附上的是全部的 (ComboBox、CheckBox、ListBox1、ListBox2)應用。
請參考裡面相關的程式碼:

TOP

回復 16# yliu
上頭附上的檔案是完全涵蓋你的 ListBox問題(2).zip 的需求,
原本是想讓你自己嘗試從中掘取出來,所以才會上傳圖片告訴你圈出的部分,
它是支很好的範例。想想還是把其它部分(案例)移除,取出你要的需求。

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

TOP

本帖最後由 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
不好意思, 現在無法上傳圖片, 只能先用文字敘述
我想只要用2個ListBox 完成選項, 太多物件 ...
yliu 發表於 2013-8-30 13:19


這便是你要的 (多選)

TOP

回復 20# yliu
如果妳將 MultiSelect:  - fmMultiSelectSingle 改成  fmMultiSelectMulti
如此 ListBox2 對應之 ListBox2_Change() 則將無任何作用,
是故你必須使用另外的方式來處理妳的勾選項,反之、
在每次勾選時都會觸動  ListBox2_Change() 。

TOP

        靜思自在 : 【停滯不前,終無所得】人都迷於尋找奇蹟,因而停滯不前;縱使時間再多、路再長,也了無用處,終無所得。
返回列表 上一主題