- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2025-7-5
|
2#
發表於 2014-9-6 04:58
| 只看該作者
Dear大大:
問題,如何參考工作表1,完成工作表2 的table。
目前想到用資料剖析,但不知如何弄?
...
jj369963 發表於 2014-9-4 17:06  - Sub nn()
- Dim iCol%, iNum%, iSB%, iSE%, iTB%, iTE%
- Dim lSRow&, lTRow&
- Dim sStr1$, sStr2$, sStr$
- Dim vD
- Dim wsSou As Worksheet, wsTar As Worksheet
-
- Set vD = CreateObject("Scripting.Dictionary")
- Set wsSou = Sheets("工作表1")
- Set wsTar = Sheets("工作表2")
- lSRow = 1
- lTRow = 2
- iCol = 2
- With wsTar
- While .Cells(1, iCol) <> ""
- vD(CStr(.Cells(1, iCol))) = iCol
- iCol = iCol + 1
- Wend
- With wsSou
- While .Cells(lSRow, 1) <> ""
- wsTar.Cells(lTRow, 1) = .Cells(lSRow, 1)
- sStr1 = .Cells(lSRow, 2)
- sStr2 = .Cells(lSRow, 3)
-
- iSB = InStr(1, sStr1, "#") + 1
- iTB = InStr(1, sStr2, "#") + 1
- While iSB < Len(sStr1)
- iSE = InStr(iSB, sStr1, "#")
- If iSE = 0 Then iSE = Len(sStr1) + 1
- iTE = InStr(iTB, sStr2, "#")
- If iTE = 0 Then iTE = Len(sStr2) + 1
- wsTar.Cells(lTRow, vD(CStr(Application.Proper(Mid(sStr1, iSB, iSE - iSB))))) = Mid(sStr2, iTB, iTE - iTB)
- iSB = iSE + 1
- iTB = iTE + 1
- Wend
- lSRow = lSRow + 1
- lTRow = lTRow + 1
- Wend
- End With
- End With
- End Sub
複製代碼 |
|