Sub TEST()
Dim Arr, Brr, xD, Dn&, T$, N&, i&, j%
Arr = Range([A1], Cells(Rows.Count, 1).End(xlUp)(1, 5))
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
For j = 1 To 4: T = T & "/" & Arr(i, j): Next
Dn = xD(T)
If Dn = 0 Then
N = N + 1: Dn = N: xD(T) = N
For j = 1 To 4: Brr(Dn, j) = Arr(i, j): Next
End If
Brr(Dn, 5) = Brr(Dn, 5) + Val(Arr(i, 5)): T = ""
Next i
If N > 0 Then [H2].Resize(N, 5) = Brr
End Sub
Dim Arr, Brr, xD, Dn&, T$, N&, i&, j%
Arr = Range([WIP!A1], [WIP!A1].Cells(Rows.Count, 1).End(xlUp)(1, 12))
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To UBound(Arr), 1 To 8)
For i = 2 To UBound(Arr)
T = Arr(i, 1) & "|" & Arr(i, 5) & "|" & Arr(i, 6) & "|" & Arr(i, 7)
Dn = xD(T)
If Dn = 0 Then
N = N + 1: Dn = N: xD(T) = N
For j = 1 To 4: Brr(Dn, j) = Arr(i, Array(1, 5, 6, 7)(j - 1)): Next
End If
j = Int(InStr("----BK-VM-TR-", "-" & Split(Arr(i, 3), "_")(1) & "-") / 3)
If j > 0 Then
Brr(Dn, j + 4) = Brr(Dn, j + 4) + Arr(i, 11)
Brr(Dn, 8) = Brr(Dn, 8) + Arr(i, 11)
End If
Next i
If N = 0 Then Exit Sub
With Sheets("工作表2")
.[A2].Resize(N, 8) = Brr
Application.Goto .[A1]
End With
End Sub
加上資料加總問題 以做排序出來了
只是想在做表單
做貼上的效果
Private Sub CommandButton1_Click()
Dim AA(), xi As Integer
With frmSelector
For xi = 0 To .ListCount - 1
' 判斷列表框 (ListBox1) 是否有被點選
If .Selected(xi) = True Then
' 取出該行之數據，存入 AA 陣列中
AA = Application.Index(frmSelector.List, xi + 1)
'With Sheets("sheet3").Range("A" & Rows.Count).Offset(1) '.Offset(1) '**還是下一儲存格
With Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) '.Offset(1) '**還是下一儲存格
.Cells = .Cells + AA
'還是 .Cells = .Cells + AA '資料是累積的
End With
End If
Next
End With
我有試著自己去用矩陣方式寫入清單方塊
可以幫我看看哪邊語法有錯誤的嗎
Private Sub TrLowData(ByVal strPackage As String, ByVal strLC As String, ByVal strBodysize As String)
Dim max As Integer
max = UBound(List)
Dim gg As Boolean
Dim LowCustomer As String
Dim BodySize As String
Dim Location As String
Dim DeviceType As String
Dim Package As String
Dim Schedule As String
Dim BK As Long
Dim LC As String
Dim TY As String
Dim VM As Long
Dim TR As Long
Dim Total As Long
'用工作表2去做排列 一行一行讀
For k = 2 To 6000
Customer = Cells(k, "A")
Package = Cells(k, "B")
BodySize = Cells(k, "C")
LC = Cells(k, "D")
BK = Cells(k, "E")
VM = Cells(k, "F")
TR = Cells(k, "G")
Total = Cells(k, "H")
If Len(Customer) = 0 Then
Exit For
End If
'比對字串作排列 以PKG.LEADCOUNT.BodySize作條件篩選
Next
If (StrComp(List(i).PKG, strPackage, vbTextCompare) = 0) And _
(StrComp(List(i).LEADCOUNT, strLC, vbTextCompare) = 0) And _
(StrComp(List(i).BodySize, strBodysize, vbTextCompare) = 0) Then
For i = 0 To max
'把結果放去LISTBOX 只秀出五筆
lstSelector.ColumnCount = 9
For i = 1 To 5
lstSelector.Additm
Next i
'這裡要keep這五個資料但是我不曉得要怎麼用語法去寫...
'在秀出五筆以LEADCOUNT.PKG 作排列
If (StrComp(List(i).LEADCOUNT, strLC, vbTextCompare) = 0) And _
(StrComp(List(i).PKG, strPackage, vbTextCompare) = 0) And _
For i = 0 To max
lstSelector.ColumnCount = 9
For i = 1 To 5
lstSelector.Additm
Next i
