- ©«¤l
- 835
- ¥DÃD
- 6
- ºëµØ
- 0
- ¿n¤À
- 915
- ÂI¦W
- 16
- §@·~¨t²Î
- Win 10,7
- ³nÅ骩¥»
- 2019,2013,2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2010-5-3
- ³Ì«áµn¿ý
- 2024-11-14
|
Dear,
§Ú¤£ª¾¹D³oÓ®Mªí°ÝÃD¯à§_¥Î¨ç¼Æ¸Ñ¨M,¦ý¦]¬°ªí®æ¤¤ªº¸ê®Æ¤j¦h¥Î¨ç¼Æ®M¥X¨Óªº,©Ò¥H¦b³o¸Ìµo°Ý...
...
PJChen µoªí©ó 2019-11-5 19:02
¨Ï¥ÎÀx¦s®æ¤½¦¡ªº¤è¦¡§Ú·Q¤£¥X¨Ó,
¦b¦¹¥u¯à¨Ï¥Î Excel VBA ¹Á¸Õ¹F¦¨ :
¥unÂIÀ» ¼t¯Êªí ªº "²£¥Í©ú²Ó" «ö¶s,
µ²ªG´N¥X¨Ó¤F...
µ{¦¡¦p¤U :- Private Sub CbCreat_Click() ' ²£¥Í©ú²Ó
- Dim iI%, iCol%
- Dim lRow&
- Dim sStr$
- Dim diPro, diTit, vA, vD1, vD2
- Dim wsSou As Worksheet, wsTar As Worksheet
-
- Set wsSou = Sheets("¥X³f")
- Set wsTar = Sheets("¼t¯Êªí")
- Set diPro = CreateObject("Scripting.Dictionary") ' °Ó«~¯Ê¼Æ
- Set diTit = CreateObject("Scripting.Dictionary") ' ¾ÚÂI¦C¼Æ
-
-
- With wsSou ' Ū¨ú¥X³f¸ê®Æ
- iCol = 45 '¼t¯Ê°_©l¦æ
- While .Cells(3, iCol) <> ""
- sStr = .Cells(3, iCol) ' ¾ÚÂI¦W
- lRow = 4 '°Ó«~°_©l¦C
- While .Cells(lRow, 8) <> "" ' °Ó«~¦WºÙ
- If .Cells(lRow, iCol) > 0 Then
- If diPro.Exists(sStr) Then
- diPro(sStr) = diPro(sStr) & "," & lRow & "-" & .Cells(lRow, iCol)
- Else
- diPro(sStr) = lRow & "-" & .Cells(lRow, iCol)
- End If
- End If
- lRow = lRow + 1
- Wend
- iCol = iCol + 1
- Wend
- End With
-
- '12 ²Ê 18
- '[d8].Font.ColorIndex = 23
- With wsTar ' ²£¥Í¼t¯Êªí
- .Range(.[A6], .Cells(Rows.Count, 8)).Delete Shift:=xlShiftUp
- lRow = 6
- For Each vA In diPro
- With .Cells(lRow, 2).Resize(, 6) ' ¾ÚÂI¦W
- With .Cells(1)
- .Value = vA
- diTit(vA) = lRow
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- With .Font
- .Size = 22
- .Bold = False
- End With
- End With
-
- With .Interior
- .Pattern = xlPatternLinearGradient
- .Gradient.Degree = 90
- .Gradient.ColorStops.Clear
- With .Gradient.ColorStops.Add(0)
- .ThemeColor = xlThemeColorDark1
- .TintAndShade = 0
- End With
- With .Gradient.ColorStops.Add(1)
- .Color = 118671
- .TintAndShade = 0
- End With
- End With
- End With
- lRow = lRow + 1
-
- sStr = diPro(vA)
- vD1 = Split(sStr, ",")
- For iI = 0 To UBound(vD1)
- vD2 = Split(vD1(iI), "-")
- .Cells(lRow, 1) = wsSou.Cells(vD2(0), 6) ' ®Æ¸¹
- .Cells(lRow, 2) = wsSou.Cells(vD2(0), 8) ' °Ó«~¦WºÙ
- .Cells(lRow, 4) = wsSou.Cells(vD2(0), 7) ' ½c¤J¼Æ
- .Cells(lRow, 5) = vD2(1) ' ¤í²~¼Æ
- .Cells(lRow, 6) = Int(vD2(1) / .Cells(lRow, 4)) ' ½c
- .Cells(lRow, 7) = vD2(1) Mod .Cells(lRow, 4) ' ²~
- .Cells(lRow, 8) = wsSou.Cells(vD2(0), 5) ' ½¦±a
- lRow = lRow + 1
- Next
- Next
-
- lRow = lRow - 1
- With .Range(.[B6], .Cells(lRow, 7))
- .Borders(xlEdgeLeft).LineStyle = xlContinuous
- .Borders(xlEdgeTop).LineStyle = xlContinuous
- .Borders(xlEdgeBottom).LineStyle = xlContinuous
- .Borders(xlEdgeRight).LineStyle = xlContinuous
- .Borders(xlInsideVertical).LineStyle = xlContinuous
- .Borders(xlInsideHorizontal).LineStyle = xlContinuous
- End With
- For Each vA In diTit
- With .Cells(diTit(vA), 2).Resize(, 6)
- .Borders(xlInsideVertical).LineStyle = xlNone
- .Borders(xlInsideHorizontal).LineStyle = xlNone
- End With
- Next
- End With
- MsgBox "¯Ê®Æ©ú²Ó¤w²£¥Í§¹²¦..."
- End Sub
½Æ»s¥N½X
¦Û°Ê®Mªí-Ans.zip (51.69 KB)
|
|