- ©«¤l
- 967
- ¥DÃD
- 0
- ºëµØ
- 0
- ¿n¤À
- 1001
- ÂI¦W
- 0
- §@·~¨t²Î
- WIN XP
- ³nÅ骩¥»
- OFFICE 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-11-29
- ³Ì«áµn¿ý
- 2022-5-17
|
¦^´_ 3# luke - Sub xx()
- Dim Rng1 As Range
- Dim Rng2 As Range
- Set d1 = CreateObject("Scripting.Dictionary")
- Set d2 = CreateObject("Scripting.Dictionary")
- With sheet3
- For Each R In .Range("A1:A" & .[A1].End(xlDown).Row)
- d1(R.Value) = R.Offset(0, 1).Value
- d2(R.Value) = R.Offset(0, 3).Value
- Next
- End With
- X = sheet3.[H1]
- Ar = Switch(X = 1, Array(2), X = 2, Array(2), X = 3, Array(2), X = 4, Array(2), X = 5, Array(2, 12), X = 6, Array(2, 12), X = 7, Array(2, 12))
- Br = Switch(X = 1, Array(4), X = 2, Array(4, 6), X = 3, Array(4, 6, 8), X = 4, Array(4, 6, 8, 10), X = 5, Array(4, 6, 8, 10), X = 6, Array(4, 6, 8, 10, 14), X = 7, Array(4, 6, 8, 10, 14, 16))
- With sheet1
- For Each R In .Range("A1:A" & .[A1].End(xlDown).Row)
- If d1.exists(R.Value) Then
- For I = 0 To UBound(Ar)
- If Rng1 Is Nothing Then Set Rng1 = .Cells(R.Row, Ar(I)) Else Set Rng1 = Union(Rng1, .Cells(R.Row, Ar(I)))
- Next I
- Rng1.Value = d1(R.Value)
- Set Rng1 = Nothing
- For j = 0 To UBound(Br)
- If Rng2 Is Nothing Then Set Rng2 = .Cells(R.Row, Br(j)) Else Set Rng2 = Union(Rng2, .Cells(R.Row, Br(j)))
- Next j
- Rng2.Value = d2(R.Value)
- Set Rng2 = Nothing
- End If
- Next
- End With
- End Sub
½Æ»s¥N½X |
|