[發問] ListBox與排序加總問題

starbox520

1.工作表2為從WIP抓過來做排序計算的資料

不過在數量這部分不知道是我哪段有問題(要做BK+VM+TR的相加)

2.想在表格"產出"  做出ListBox(還是有其他方法呢)

此ListBox可以列出我現在所選的編號那欄對應的第一排

從"工作表2"的資料列出先與"Package"相同的次要是"BodySize"列出 然後"數量"由大至小

可以貼在"產出"紅色的儲存格，每一個編號都對應到同一欄

在點擊選出的內容可以秀出此筆資料相加前的內容

下載 (40.83 KB)
此為LIST清單秀出的樣子

2016-10-16 01:16

下載 (15.45 KB)
此為編號SQH011作範例

2016-10-16 01:16

下載 (20.41 KB)
此為左圖點選SYNAP會跑出的樣子

2016-10-16 01:16

TTR1表.rar (576.39 KB)

下載次數: 5

2016-10-16 01:22

starbox520

回復 78# jeffrey628litw


    沒錯這隻程式用了很多前輩的精隨
   
    學到了很多東西

jeffrey628litw

各位大大的功力真是太強了，看得眼花撩亂，整理到最後，給各位看看，應該是正確的了。

TR00.rar (983.88 KB)

下載次數: 2

2017-3-20 09:47

TR 0007.rar (944.24 KB)

下載次數: 2

2017-3-20 09:46

c_c_lai

回復 76# starbox520

1.             With Sheets("TR排機&產出").Sh_Rng.Offset(1)

複製代碼

改成

1.             With Sheets("TR排機&產出").Sh_Rng.Offset(1, -1)

複製代碼

starbox520

1. Private Sub CommandButton1_Click()
   
2.     Dim AA, i As Integer, ii As Integer
   
3.     With lstSelector
   
4.         For i = 0 To .ListCount - 1
   
5.             If .Selected(i) Then
   
6.                 If IsEmpty(AA) Then ReDim AA(1 To 4, 1 To 1) Else ReDim Preserve AA(1 To 4, 1 To UBound(AA, 2) + 1)
   
7.                 For ii = 1 To 4
   
8.                     AA(ii, UBound(AA, 2)) = .List(i, ii - 1)
   
9.                 Next
   
10.             End If
    
11.         Next
    
12.     End With
    
13.     If IsEmpty(AA) Then
    
14.         MsgBox "你沒有選取資料"
    
15.     ElseIf UBound(AA, 2) > 4 Then
    
16.         MsgBox "你選取 超過 4 筆 資料"
    
17.     Else
    
18.         If MsgBox("共 選取 " & UBound(AA, 2) & " 筆資料" & vbLf & "確定輸入", vbYesNo) = vbYes Then
    
19.             With Sheets("TR排機&產出").Sh_Rng.Offset(1)
    
20.                 .Resize(4, 4) = ""
    
21.                 .Resize(UBound(AA, 1), UBound(AA)) = Application.Transpose(AA)
    
22.             End With
    
23.         End If
    
24.     End If
    
25. End Sub

複製代碼

回復 74# GBKEE

結果換貼上這邊多往右邊移一格了...

下載 (17.05 KB)

2016-11-8 08:33

starbox520

回復 74# GBKEE


    好的~謝謝C大跟版大
    我回去試試
    我老家沒電腦....哈哈

GBKEE

回復 70# starbox520

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)   
   
2.     If IsError(Target(1)) Then Unload frmSelector:         Exit Sub
   
3. '    If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
   
4.      If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 6 Then
   
5.         'Set Sh_Rng = Cells(Target(1).Row, "E")
   
6.         Set Sh_Rng = Cells(Target(1).Row, "F")  '**這裡也要改
   
7.         Ex_Customer_Package
   
8.         
   
9.         If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "找不到": Exit Sub
   
10.         Unload frmSelector
    
11.         frmSelector.Show False
    
12.     Else
    
13.         Unload frmSelector
    
14.     End If
    
15. End Sub

複製代碼

c_c_lai

回復 72# starbox520
看了 #68 的說明，以及 #69 GBKEE 大大的回復，才知問題出在：

1. Worksheet_SelectionChange()：
   
2.     If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 6 Then
   
3.     (依照 GBKEE 大大 的修正指示)

複製代碼

1. Ex_Customer_Package()：
   
2.     If .Cells(i, 2) = Sh_Rng And .Cells(i, 3) = Sh_Rng(1, 2) Then
   
3.     (修改成)
   
4.     If .Cells(i, 2) = Sh_Rng(1, 2) And .Cells(i, 3) = Sh_Rng(1, 3) Then

複製代碼

執行起來，一切看似 OK。

下載 (54.95 KB)

2016-11-4 05:57

   
接下來的執行，便又變回原樣了：

下載 (60.94 KB)

2016-11-4 05:59

請參考之前的提示 (#63) 予以更新。

starbox520

回復 71# c_c_lai


    回大大  
    不懂您的意思= ="
    我是照#69  版大  所叫我修改的去改的

c_c_lai

回復 70# starbox520
工作表單 "TR排機&產出"：
Worksheet_SelectionChange() 以及
Ex_Customer_Package() 內改成備註
之處改回原來。