- 帖子
- 91
- 主題
- 5
- 精華
- 0
- 積分
- 130
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2016-5-14
- 最後登錄
- 2020-5-17
|
7#
發表於 2017-11-6 18:09
| 只看該作者
回復 1# adrian_9832
參考看看
這程式未考慮找尋NN但只差最後一字的部分，會覆蓋前面已填入過- Public Sub text()
- Dim FindRange As Range, FindString As Range
- lastRow = Cells(ActiveSheet.Rows.Count, 2).End(xlUp).Row
- Set FindRange = Worksheets(1).Range(Cells(1, 2), Cells(lastRow, 2))
- Set FindString = Worksheets(1).Range(Cells(9, 13), Cells(Cells(ActiveSheet.Rows.Count, 13).End(xlUp).Row, 13))
- For Each a In FindString
- a1 = Left(a.Value, Len(a.Value) - 1)
- Set c = FindRange.Find(a1, LookIn:=xlValues)
-
- If Not c Is Nothing Then
- firstAddress = c.Address
- Do
- Cells(c.Row, 8).Value = Cells(a.Row, a.Column - 1).Value
- Cells(c.Row, 9).Value = a.Value
- Set c = FindRange.FindNext(c)
- Loop While Not c Is Nothing And c.Address <> firstAddress
- End If
- Next
- End Sub
|
|
