- 帖子
- 192
- 主題
- 15
- 精華
- 0
- 積分
- 194
- 點名
- 0
- 作業系統
- windows
- 軟體版本
- office2010
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2016-9-22
- 最後登錄
- 2020-8-28
 
|
28#
發表於 2016-10-21 00:13
| 只看該作者
'排列
Sub ArrangeMent()
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
End Sub
只是試了很久都沒有反應 ...
 0992.rar (487.86 KB)
|
|
發表於 2016-10-12 09:22
| 
發表於 2016-10-13 09:47
| 
