- 帖子
- 192
- 主題
- 15
- 精華
- 0
- 積分
- 194
- 點名
- 0
- 作業系統
- windows
- 軟體版本
- office2010
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2016-9-22
- 最後登錄
- 2020-8-28
 
|
回復 56# starbox520
回版大 我後來有自己排出來了!!!!
讓您頭痛了XDDD.....
請問為什麼顯示一筆資料的時候會這樣呢
- Private Sub lstSelector_設定()
- With lstSelector
- ' **取消 .MultiSelect = 1 *** MultiSelect 屬性 指定物件是否接受多重選取。
- If Not IsEmpty(Sheets("TR排機&產出").Sh_Ar) Then .List = Sheets("TR排機&產出").Sh_Ar
- End With
- With ListBox1 '**frmSelector中的第二個ListBox 控制項
- .ColumnCount = 9
- .ColumnWidths = "60,35,75,40,30,60,30,70,30"
-
- End With
- End Sub
- Private Sub lstSelector_Change()
- If lstSelector.ListIndex > -1 Then Ex_WIP
- End Sub
- Private Sub Ex_WIP()
- Dim i As Integer, Ar, A(1 To 4), Ab(), ii As Integer
- With Me.lstSelector
- For i = 0 To 3
- A(i + 1) = .List(.ListIndex, i)
- Next
- End With
- i = 2
- With Sheets("WIP")
- Do While .Cells(i, 1) <> ""
- ' If .Cells(i, "A") = A(1) And .Cells(i, "E") = A(2) And .Cells(i, "G") = A(3) And .Cells(i, "F") = A(4) Then
- If .Cells(i, "A") = A(1) And .Cells(i, "E") = A(2) And .Cells(i, "G") = A(3) And CStr(.Cells(i, "F")) = A(4) Then
-
- If IsEmpty(Ar) Then ReDim Ar(1 To 1) Else ReDim Preserve Ar(1 To UBound(Ar) + 1)
- '顯示我要的資料
- Ar(UBound(Ar)) = Array(.Cells(i, "A").Text, .Cells(i, "C").Text, .Cells(i, "D").Text, .Cells(i, "E").Text, .Cells(i, "G").Text, .Cells(i, "F").Text, .Cells(i, "K").Text, .Cells(i, "I").Text, .Cells(i, "P").Text) 'K欄
-
-
- '** Listbox 最多顯示 9列
- End If
- i = i + 1
- Loop
- End With
- '***********************************
- '**frmSelector中的第二個ListBox 控制項
- With ListBox1
- .Clear
- If UBound(Ar) > 1 Then
- .List = Application.Transpose(Application.Transpose(Ar))
- ElseIf UBound(Ar) = 1 Then
- .List = Ar(1)
- End If
- End With
- '***********************************
- End Sub
- '******************************
- Public Sh_Rng As Range, Sh_Ar
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- If IsError(Target(1)) Then Unload frmSelector: Exit Sub
- If (Target(1).Row + 1) Mod 5 = 0 And Target(1) <> "" And Target(1).Column = 5 Then
- Set Sh_Rng = Cells(Target(1).Row, "E")
- Ex_Customer_Package
- If IsEmpty(Sh_Ar) Then MsgBox Sh_Rng & "-" & Sh_Rng(1, 2) & vbLf & "找不到": Exit Sub
- Unload frmSelector
- frmSelector.Show False
- Else
- Unload frmSelector
- End If
- End Sub
- Private Sub Ex_Customer_Package()
- Dim i As Integer, ii As Integer, Ar
- Sh_Ar = Ar: i = 2
- With Sheets("工作表2")
- Do While .Cells(i, 1) <> ""
- If .Cells(i, 1) = Sh_Rng And .Cells(i, 2) = Sh_Rng(1, 2) Then
- If IsEmpty(Ar) Then ReDim Ar(1 To 8, 1 To 1) Else ReDim Preserve Ar(1 To 8, 1 To UBound(Ar, 2) + 1)
- For ii = 1 To 8
- Ar(ii, UBound(Ar, 2)) = .Cells(i, ii).Text
- Next
- End If
- i = i + 1
- Loop
- End With
- If IsEmpty(Ar) Then Exit Sub
- Sh_Ar = Application.Transpose(Ar)
- End Sub
|
|
發表於 2016-10-27 22:39
| 
