- ©«¤l
- 192
- ¥DÃD
- 15
- ºëµØ
- 0
- ¿n¤À
- 194
- ÂI¦W
- 0
- §@·~¨t²Î
- windows
- ³nÅ骩¥»
- office2010
- ¾\ŪÅv
- 20
- ©Ê§O
- ¤k
- µù¥U®É¶¡
- 2016-9-22
- ³Ì«áµn¿ý
- 2020-8-28
|
'±Æ¦C
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("¤u§@ªí2")
.[A2].Resize(N, 8) = Brr
Application.Goto .[A1]
End With
End Sub
¥[¤W¸ê®Æ¥[Á`°ÝÃD ¥H°µ±Æ§Ç¥X¨Ó¤F
¥u¬O·Q¦b°µªí³æ
°µ¶K¤Wªº®ÄªG
Private Sub CommandButton1_Click()
Dim AA(), xi As Integer
With frmSelector
For xi = 0 To .ListCount - 1
' §PÂ_¦Cªí®Ø (ListBox1) ¬O§_¦³³QÂI¿ï
If .Selected(xi) = True Then
' ¨ú¥X¸Ó¦æ¤§¼Æ¾Ú¡A¦s¤J AA °}¦C¤¤
AA = Application.Index(frmSelector.List, xi + 1)
'With Sheets("sheet3").Range("A" & Rows.Count).Offset(1) '.Offset(1) '**ÁÙ¬O¤U¤@Àx¦s®æ
With Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) '.Offset(1) '**ÁÙ¬O¤U¤@Àx¦s®æ
.Cells = .Cells + AA
'ÁÙ¬O .Cells = .Cells + AA '¸ê®Æ¬O²Ö¿nªº
End With
End If
Next
End With
End Sub
¥u¬O¸Õ¤F«Ü¤[³£¨S¦³¤ÏÀ³ ...
0992.rar (487.86 KB)
|
|