ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦Û°Ê®Mªí

¥»©«³Ì«á¥Ñ PJChen ©ó 2019-11-16 23:17 ½s¿è

¦^´_ 2# luhpro

½Ð°Ý¤j¤j,
¤@¯ë§Ú¦b¥ÎVBA®É,¥ÎAlt + F11´N¥i¥H¬Ý¨ìModuleªºµ{¦¡½X,¬°¤°»ò±z¼gªºµ{¦¡¬Ý¤£¨ìModule ?
¥t¥~¦]¬°ªí®æ¤@¶}©lªºª¬ºA³£¬OªÅ¥Õªº,¶ñ¤J¸ê®Æ®É­n±q²Ä3¦C¶}©l,¦ý¦b´ú¸Õ®É³£·|±q²Ä6¦C¶}©l¶ñ,¥i§_À°¦£§ï¬°°_©l¥Ñ²Ä3¦C¶}©l¼g¤J¸ê®Æ?
¥t¥~§Úªºµ{¦¡­n©ñ¦b¥t¤@ÀÉ®×Macro.xlsm¤¤°õ¦æ,¨Ã«ü©wÀɦW"³Ì·s®w¦s.xlsx"½Ð°Ýµ{¦¡­n«ç»ò­×¥¿?
ÁÂÁ±z

TOP

¦^´_ 2# luhpro
¯u¬O¤Ó·PÁ¤F...

TOP

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¦¨ :
¥u­nÂIÀ» ¼t¯Êªí ªº "²£¥Í©ú²Ó" «ö¶s,
µ²ªG´N¥X¨Ó¤F...
µ{¦¡¦p¤U :
  1. Private Sub CbCreat_Click() ' ²£¥Í©ú²Ó
  2.   Dim iI%, iCol%
  3.   Dim lRow&
  4.   Dim sStr$
  5.   Dim diPro, diTit, vA, vD1, vD2
  6.   Dim wsSou As Worksheet, wsTar As Worksheet
  7.   
  8.   Set wsSou = Sheets("¥X³f")
  9.   Set wsTar = Sheets("¼t¯Êªí")
  10.   Set diPro = CreateObject("Scripting.Dictionary") ' °Ó«~¯Ê¼Æ
  11.   Set diTit = CreateObject("Scripting.Dictionary") ' ¾ÚÂI¦C¼Æ
  12.   
  13.   
  14.   With wsSou ' Ū¨ú¥X³f¸ê®Æ
  15.     iCol = 45 '¼t¯Ê°_©l¦æ
  16.     While .Cells(3, iCol) <> ""
  17.       sStr = .Cells(3, iCol) ' ¾ÚÂI¦W
  18.       lRow = 4 '°Ó«~°_©l¦C
  19.       While .Cells(lRow, 8) <> "" ' °Ó«~¦WºÙ
  20.         If .Cells(lRow, iCol) > 0 Then
  21.           If diPro.Exists(sStr) Then
  22.             diPro(sStr) = diPro(sStr) & "," & lRow & "-" & .Cells(lRow, iCol)
  23.           Else
  24.             diPro(sStr) = lRow & "-" & .Cells(lRow, iCol)
  25.           End If
  26.         End If
  27.         lRow = lRow + 1
  28.       Wend
  29.       iCol = iCol + 1
  30.     Wend
  31.   End With
  32.   
  33. '12 ²Ê 18
  34. '[d8].Font.ColorIndex = 23


  35.   With wsTar ' ²£¥Í¼t¯Êªí
  36.     .Range(.[A6], .Cells(Rows.Count, 8)).Delete Shift:=xlShiftUp
  37.     lRow = 6
  38.     For Each vA In diPro
  39.       With .Cells(lRow, 2).Resize(, 6) ' ¾ÚÂI¦W
  40.         With .Cells(1)
  41.           .Value = vA
  42.           diTit(vA) = lRow
  43.           .HorizontalAlignment = xlCenter
  44.           .VerticalAlignment = xlCenter
  45.           With .Font
  46.             .Size = 22
  47.             .Bold = False
  48.           End With
  49.         End With
  50.         
  51.         With .Interior
  52.             .Pattern = xlPatternLinearGradient
  53.             .Gradient.Degree = 90
  54.             .Gradient.ColorStops.Clear
  55.           With .Gradient.ColorStops.Add(0)
  56.             .ThemeColor = xlThemeColorDark1
  57.             .TintAndShade = 0
  58.           End With
  59.           With .Gradient.ColorStops.Add(1)
  60.             .Color = 118671
  61.             .TintAndShade = 0
  62.           End With
  63.         End With
  64.       End With
  65.       lRow = lRow + 1
  66.       
  67.       sStr = diPro(vA)
  68.       vD1 = Split(sStr, ",")
  69.       For iI = 0 To UBound(vD1)
  70.         vD2 = Split(vD1(iI), "-")
  71.         .Cells(lRow, 1) = wsSou.Cells(vD2(0), 6) ' ®Æ¸¹
  72.         .Cells(lRow, 2) = wsSou.Cells(vD2(0), 8) ' °Ó«~¦WºÙ
  73.         .Cells(lRow, 4) = wsSou.Cells(vD2(0), 7) ' ½c¤J¼Æ
  74.         .Cells(lRow, 5) = vD2(1) ' ¤í²~¼Æ
  75.         .Cells(lRow, 6) = Int(vD2(1) / .Cells(lRow, 4)) ' ½c
  76.         .Cells(lRow, 7) = vD2(1) Mod .Cells(lRow, 4) ' ²~
  77.         .Cells(lRow, 8) = wsSou.Cells(vD2(0), 5) ' ½¦±a
  78.         lRow = lRow + 1
  79.       Next
  80.     Next
  81.    
  82.     lRow = lRow - 1
  83.     With .Range(.[B6], .Cells(lRow, 7))
  84.       .Borders(xlEdgeLeft).LineStyle = xlContinuous
  85.       .Borders(xlEdgeTop).LineStyle = xlContinuous
  86.       .Borders(xlEdgeBottom).LineStyle = xlContinuous
  87.       .Borders(xlEdgeRight).LineStyle = xlContinuous
  88.       .Borders(xlInsideVertical).LineStyle = xlContinuous
  89.       .Borders(xlInsideHorizontal).LineStyle = xlContinuous
  90.     End With
  91.     For Each vA In diTit
  92.       With .Cells(diTit(vA), 2).Resize(, 6)
  93.         .Borders(xlInsideVertical).LineStyle = xlNone
  94.         .Borders(xlInsideHorizontal).LineStyle = xlNone
  95.       End With
  96.     Next
  97.   End With
  98.   MsgBox "¯Ê®Æ©ú²Ó¤w²£¥Í§¹²¦..."
  99. End Sub
½Æ»s¥N½X
¦Û°Ê®Mªí-Ans.zip (51.69 KB)

TOP

        ÀR«ä¦Û¦b : °ß¨ä´L­«¦Û¤vªº¤H¡A¤~§ó«i©óÁY¤p¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD