- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 133
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2025-6-1
               
|
¦^´_ 11# loyyee
¨Ã«D¸ê®Æµ§¼Æ°ÝÃD
¬O¦pªG¨S¦³©M±ø¥óªº¸ê®Æ´N·|³y¦¨Resize¥X¿ù- Sub Ex()
- Dim Ay(), Ay1()
- Set d = CreateObject("Scripting.dictionary")
- Set d1 = CreateObject("Scripting.dictionary")
- [E6].CurrentRegion.Offset(1, 0) = ""
- [I1].CurrentRegion.Offset(1, 0) = ""
- ar1 = [A1].CurrentRegion.Columns(1).Value
- ar2 = [A1].CurrentRegion.Columns(2).Value
- ar = Array(ar1, ar2)
- For i = 0 To 1
- For Each a In ar(i)
- Select Case i
- Case 0
- If a <> "" Then d(a) = d(a) + 1
- Case 1
- If a <> "" Then d1(a) = d1(a) + 1
- End Select
- Next
- Next
- dic = Array(d, d1)
- For i = 0 To 1
- For Each ky In dic(i).keys
- p = IIf(i = 0, 1, 0)
- If dic(p).exists(ky) = False Then
- ReDim Preserve Ay(s)
- Ay(s) = ky
- s = s + 1
- End If
- If dic(i)(ky) > 1 Then
- ReDim Preserve Ay1(k)
- Ay1(k) = ky
- k = k + 1
- End If
- Next
- If s > 0 Then Cells(2, 9 + i).Resize(s, 1) = Application.Transpose(Ay): s = 0: Erase Ay
- If k > 0 Then Cells(7, 5 + i).Resize(k, 1) = Application.Transpose(Ay1): k = 0: Erase Ay1
- Next
- End Sub
½Æ»s¥N½X |
|