- ©«¤l
- 254
- ¥DÃD
- 6
- ºëµØ
- 0
- ¿n¤À
- 310
- ÂI¦W
- 0
- §@·~¨t²Î
- W10
- ³nÅ骩¥»
- Excel 2016
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2019-6-16
- ³Ì«áµn¿ý
- 2024-9-23
|
¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2020-10-30 01:36 ½s¿è
¦^´_ 43# wei9133
©ÎµÛ§ï¦¨³o¼Ë ¬Ý¬Ý ¬O¤£¬O§Anªºµ²ªG ÁÙ¬O»¡ jcchiang«e½ú ªº¤~¬O§Anªºµ²ªG- Public Sub ½m²ß1030()
- Sheets(2).Select
- Rows(2).Select
- ActiveWindow.FreezePanes = False
- Application.ScreenUpdating = False
- Sheets(2).[a1].CurrentRegion.Clear
- Sheets(1).Select
- Dim Arr, d, xD, x&, y&, k&, T1$, T2$, T3$, T4$
- Set xD = CreateObject("Scripting.Dictionary")
- Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
- For x = 2 To UBound(Arr, 1)
- T1 = ""
- For y = 1 To 51
- T1 = T1 & Arr(x, y)
- If Arr(x, y) = "" Then T1 = T1 & "-"
- Next y
- T3 = ""
- For y = 52 To 102
- T3 = T3 & Arr(x, y)
- If Arr(x, y) = "" Then T3 = T3 & "-"
- Next y
- If T1 = T3 Then
- T1 = T1 & T3 & Arr(x, 106)
- T3 = ""
- If Arr(x, 103) = "" Then
- Arr(x, 103) = 1
- xD(T1) = xD(T1) + Arr(x, 103)
- ElseIf Arr(x, 103) <> "" Then
- xD(T1) = xD(T1) + Arr(x, 103)
- End If
- xD(T1 & 105) = xD(T1 & 105) + Arr(x, 105)
- End If
- Next x
- T1 = "": T3 = ""
- For Each d In xD
- For x = UBound(Arr, 1) To 2 Step -1
- T2 = ""
- For y = 1 To 51
- T2 = T2 & Arr(x, y)
- If Arr(x, y) = "" Then T2 = T2 & "-"
- Next y
- T4 = ""
- For y = 52 To 102
- T4 = T4 & Arr(x, y)
- If Arr(x, y) = "" Then T4 = T4 & "-"
- Next y
- If T2 = T4 Then
- T2 = T2 & T4 & Arr(x, 106)
- T4 = ""
- If d = T2 Then
- E = E + 1
- If E = 1 Then
- If Arr(x, 103) > 0 Then Arr(x, 103) = xD(d)
- If Arr(x, 103) <= 1 Then Arr(x, 103) = ""
- Else
- Arr(x, 103) = xD(d) - 1
- If Arr(x, 103) < 0 Then Arr(x, 103) = Arr(x, 103) * -1
- End If
- Arr(x, 105) = xD(d & 105)
- If xD(d & 105) = 0 Then Arr(x, 105) = ""
- End If
- End If
- Next x
- E = 0
- Next d
- T2 = "": T4 = "": d = "": k = 1
- Set xD = Nothing
- For x = 2 To UBound(Arr, 1)
- If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
- Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
- k = k + 1
- For y = 1 To UBound(Arr, 2)
- Arr(k, y) = Arr(x, y)
- Next y
- End If
- Next x
- T2 = "": T4 = ""
- Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = ""
- Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = Arr
- Erase Arr
- Application.ScreenUpdating = True
- Sheets(2).Select
- Rows(2).Select
- ActiveWindow.FreezePanes = True
- Cells(Rows.Count, 106).End(xlUp).Select
- End Sub
½Æ»s¥N½X |
|