- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
|
¦^´_ 7# b9208
ü¶g¦¸¨S¦³§Ë¦n,§ó¥¿¦p¤U- Option Explicit
- Dim D(1 To 2) As Object, ¶g¦¸ As Object, Ar ' 'Dim : ¦¹¼Ò²Õªº¨p¥ÎÅܼÆ(¶È¦¹¼Ò²Õ¥i¥Î)
- Sub EX()
- Dim i As Integer, ii As Integer, M As String, Rng As Range, ²Îp³æ¦ì As Variant
- Set D(1) = CreateObject("scripting.dictionary") '¦r¨åª«¥ó
- Set D(2) = CreateObject("scripting.dictionary")
- Set ¶g¦¸ = CreateObject("scripting.dictionary")
- With Sheets("²Îp")
- i = Application.CountA(.[b4:b13])
- ²Îp³æ¦ì = Join(Application.Transpose(.Range(.[b4], .[b4].Offset(i - 1))), ",") '²Îp³æ¦ì=QWE,ASD
- End With
- With Sheets("©ú²Ó")
- i = 6
- Do While .Cells(i, "D") <> ""
- ' "," & ²Îp³æ¦ì & "," -> ,QWE,ASD,
- If InStr("," & ²Îp³æ¦ì & ",", "," & .Cells(i, "F") & ",") Then '¤ñ¹ï¨ì ,QWE, ,ASD, .....
-
- If InStr("," & ¶g¦¸(.Cells(i, "F").Value) & ",", "," & Mid(.Cells(i, "E"), 1, 4)) & "," = 0 Then '²Îp³æ¦ì: ¤ñ¹ï¶g¦¸¤£¦s¦b, .....
- ¶g¦¸(.Cells(i, "F").Value) = IIf(¶g¦¸(.Cells(i, "F").Value) = "", "", ¶g¦¸(.Cells(i, "F").Value) & ",") & Mid(.Cells(i, "E"), 1, 4)
- End If
-
- M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F")
- D(1)(M) = D(1)(M) + 1 '¥þ³¡
- M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F") & .Cells(i, "L")
- D(2)(M) = D(2)(M) + 1 '°Ï°ì
- End If
- i = i + 1
- Loop
- End With
- With Sheets("²Îp")
- .[F:IQ].Clear
- For i = 0 To Application.CountA(.Range("B4:B13")) - 1
- Ar = Array("¥þ³¡", "³æ¦ì", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun", "¤pp")
- If i = 0 Then
- Set Rng = .[F3]
- Else
- Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6) '¨C±iªí®æ¶¡¹j¤¦C
- End If
-
- ¶g¦¸(.Range("B4").Offset(i).Value) = Split(¶g¦¸(.Range("B4").Offset(i).Value), ",")
- '¨ú±o²Îp³æ¦ì¤§¶g¦¸
-
- ªí®æ»s³y Rng, .Range("B4").Offset(i)
- ªí®æ²Îp Rng.CurrentRegion
-
- For ii = 0 To Application.CountA(.Range("B18:B21")) - 1
- Set Rng = .Cells(.Rows.Count, "F").End(xlUp).Offset(6) '¨C±iªí®æ¶¡¹j¤¦C
- Ar(0) = .[B18].Offset(ii)
- ªí®æ»s³y Rng, .Range("B4").Offset(i)
- ªí®æ²Îp Rng.CurrentRegion
- Next
- Next
- End With
- End Sub
- Private Sub ªí®æ»s³y(Rng As Range, ³æ¦ì As String)
- Rng.Resize(UBound(Ar) + 1).Value = Application.Transpose(Ar)
- With Rng.Offset(, 1).Resize(1, UBound(¶g¦¸(³æ¦ì)) + 1)
- .Value = ¶g¦¸(³æ¦ì)
- .Offset(1) = ³æ¦ì
- End With
- Rng.CurrentRegion.Borders.LineStyle = 1 '®Ø½u
- End Sub
- Private Sub ªí®æ²Îp(Rng As Range)
- Dim R As Integer, C As Integer
- With Rng
- For R = 3 To .Rows.Count - 1
- For C = 2 To .Columns.Count
- If .Cells(1) = "¥þ³¡" Then '¥þ³¡
- .Cells(R, C) = D(1)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C))
- Else '°Ï°ì
- .Cells(R, C) = D(2)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C) & .Cells(1))
- End If
- Next
- Next
- For C = 2 To .Columns.Count
- .Cells(.Rows.Count, C).FormulaR1C1 = "=SUM(R[-" & .Rows.Count - 3 & "]C:R[-1]C)" '¤½¦¡
- .Cells(.Rows.Count, C) = .Cells(.Rows.Count, C).Value
- Next
- End With
- End Sub
½Æ»s¥N½X |
|