- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
2#
發表於 2016-7-14 19:15
| 只看該作者
回復 1# Michelle-W
試試看！- Sub Ex()
- Dim lg As Variant, ctn As Variant, xi As Integer
- Dim dic As Object, sp As Variant, sh As Worksheet
-
- Set sh = Worksheets("05月")
- Set dic = CreateObject("scripting.dictionary")
-
- With sh
- For Each lg In .Range("B1:I1")
- .Select
-
- dic(lg.Value) = ""
- For Each ctn In .Range("A2:A7")
- If ctn.Offset(, lg.Column - 1) = "V" Then
- dic(lg.Value) = dic(lg.Value) + IIf(dic(lg.Value) = "", "", ",") + ctn.Value
- End If
- Next
- sp = Split(dic(lg.Value), ",")
- ' Cells(15, lg.Column).Resize(UBound(sp) + 1) = Application.Transpose(Array(sp)) ' 展示用
-
- For xi = 1 To Worksheets.Count
- If Worksheets(xi).Name = lg.Value Then Worksheets(xi).Select: Exit For
- Next xi
- If xi > Worksheets.Count Then
- Sheets.Add After:=Sheets(Worksheets.Count)
- ActiveSheet.Name = lg.Value
- End If
- With Worksheets(lg.Value)
- .[A1] = sh.[A1]
- .[B1] = lg.Value
- .[A2].Resize(UBound(sp) + 1) = Application.Transpose(Array(sp))
- .[B2].Resize(UBound(sp) + 1) = "V"
- End With
- Next
- End With
- End Sub
|
|
