返回列表 上一主題 發帖

跨表,重新製作新的工作表

跨表,重新製作新的工作表

功能就是我在sheet2 的A2 輸入,然後它會到shee1的a欄中找 sheet2 a2 輸入的值,並復製其資料在sheet2 B欄重新編號一直下去

可以不要用程式就不要用,因為大家都是高手,我都看不懂

搜尋.rar (2.86 KB)

感謝 准提部林 大大的指導,在 office 2003 執行也很順利,本來是不太想學程式如何寫的,只覺得一些公式會用就好,看樣子要稍微學一下程式了,往後不懂的地方在請各位大師指導,謝謝了

TOP

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xF As Range, xE As Range
With Target
   If .Address <> "$A$2" Then Exit Sub
   If .Value = "" Then Exit Sub
   Set xF = [Sheet1!A:A].Find(.Value, Lookat:=xlWhole)
   If xF Is Nothing Then MsgBox "無此資料": GoTo 999 '找不到,跳至〔標記999〕,並結束執行 
   Set xE = Cells(Rows.Count, "B").End(xlUp)(2) 'B欄最後一筆資料的下一空白格 
   Application.EnableEvents = False
   xF.Resize(1, 7).Copy xE '複製內容(含格式) 
   xE = xE.Row - 1 '〔序號〕以〔列號〕減1 
End With
999:
Target.Select
Application.EnableEvents = True
End Sub


以下兩行意思一樣:
Set xE = Cells(Rows.Count, "B").End(xlUp)(2)
Set xE = Cells(Rows.Count, "B").End(xlUp).Cells(2, 1)

TOP

謝謝 lpk187 大大 其實這樣就很好用了,很讚喔,不用太傷腦了,感謝

TOP

回復 10# regedit77


    按清除鈕後是把所有的內容資料清除,不是只有清除顏色,這樣的動作是正確的!!其實這動作也是當你清除資料後,也恢復原來文字的色彩,若不想在一起,你也可以把它分開
另外,會出現問題的地方應該是2003不支援,其實可以把那一列刪除掉的!
搜尋.rar (13.59 KB)

TOP

感謝 lpk187 大大 的幫忙,現在有兩個問題 第一個就是在office2003 下執行發生了如圖的錯誤,然後在office2013 下執行正常沒問題但按清除鈕後是把所有的內容資料清除,不是只有清除顏色,這樣的動作是正確的嗎,如果sheet1 的字是有斜體或粗體加顏色可以復製過去嗎,如果不行也沒關係,這樣就很棒了,謝謝lpk187大大 1.JPG

TOP

回復 8# regedit77

搜尋.rar (12.5 KB)
檔案中有加了一個巨集,"清除",是儲存格格式的文字色彩,改回原來的自動

TOP

本帖最後由 regedit77 於 2015-11-22 07:06 編輯

搜尋.rar (12.47 KB) 之前這 lpk187 所設計的 搜尋.V2.rar 很好用,但現在需要新增一個小功能的問題是,如果所始資料sheet1 的某列資料字有顏色區別的話考貝到sheet2 不會一樣有顏色,可以讓他復製過去時,字的顏色一起過去嗎?

因為一開始時,是想說不用程式的方法達成,所以就延續它下來,希望版主原諒

TOP

感謝 lpk187 大大 的指導及貼心 ,還把 A2 欄位設定好,每次都會自行反回

再次感謝 lpk187

TOP

回復 5# regedit77


    搜尋.V2.rar (12.51 KB)

TOP

        靜思自在 : 難行能行,難捨能捨,難為能為,才能昇華自我的人格。
返回列表 上一主題