複製資料轉寫到另一工作表 - Excel程式區

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

論壇贊助勳章

16^# 跳轉到 »

發表於 2013-8-30 13:19 | 只看該作者

回復 15# c_c_lai
不好意思, 現在無法上傳圖片, 只能先用文字敘述
我想只要用2個ListBox 完成選項, 太多物件會佔空間,我的做法是:
單號的[List Box2] 可一次勾選單號TW-1301001及TW1301002
明細的[List Box1]就會出現共4筆序號明細TW-1301001 001, TW-1301001 002, TW-1301001 003, TW-1301002 001
只是希望想用別的寫法簡化我的多層迴圈判斷.

learner

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

15^#

發表於 2013-8-30 12:19 | 只看該作者

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

TOP

yliu

中學生 Rank: 2

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

論壇贊助勳章

14^#

發表於 2013-8-30 12:11 | 只看該作者

回復 13# c_c_lai

不好意思, 我要的是2個ListBox都能複選, 也就是單號的ListBox複選完後(跨單號,不是單一), 其明細都會出現在明細的ListBox, 然後再去勾選要的序號明細.
我的寫法太多層,希望能簡化. 不知是否提供較好的寫法.檔案是昨天貼上的那個檔案. 謝謝~

learner

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

13^#

發表於 2013-8-30 08:50 | 只看該作者

回復 12# yliu
套用你原本的檔案，並加以稍稍修改，看看是否符合你的需求。
請觀察 ThisWorkbook 與 Sheet1 (login) 間之互動。
P.S. 另額外增加了 Checkbox 的應用，供參考。

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

TOP

yliu

中學生 Rank: 2

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

論壇贊助勳章

12^#

發表於 2013-8-29 23:55 | 只看該作者

有兩個ListBox, 一個是單號(ListBox2), 一個是單號明細(ListBox1),都可以複選, 請詳附件

ListBox問題(2).zip (23.22 KB)
想請問版上高手, ListBox2的程式是否有更好的寫法?
我目前寫法是:
Private Sub ListBox2_Change()
Dim lrow, irow, ai As Integer
Sheets("login").ListBox1.Clear
[A9:E19] = ""
With ListBox2

For lrow = 0 To .ListCount - 1

  If .Selected(lrow) Then
With Sheets(Sh)
   ai = 2
   Do While .Cells(ai, "A") <> ""
If .Cells(ai, "A") = ListBox2.List(lrow, 0) Then
   With ListBox1
      .AddItem
      irow = .ListCount
   .List(irow - 1, 0) = Sheets(Sh).Cells(ai, "A")
   .List(irow - 1, 1) = Sheets(Sh).Cells(ai, "B")
   .List(irow - 1, 2) = Sheets(Sh).Cells(ai, "C")
   .List(irow - 1, 3) = Sheets(Sh).Cells(ai, "D")
   .List(irow - 1, 4) = Sheets(Sh).Cells(ai, "E")
      End With
   End If
ai = ai + 1
Loop
End With
End If
Next
End With
Application.EnableEvents = True
End Sub

learner

TOP

yliu

中學生 Rank: 2

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

論壇贊助勳章

11^#

發表於 2013-8-7 23:38 | 只看該作者

回復 10# GBKEE

謝謝GBKEE!

learner

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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