Board logo

標題: 跨表，重新製作新的工作表 [打印本頁]
作者: regedit77    時間: 2015-8-25 14:17     標題: 跨表，重新製作新的工作表

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

可以不要用程式就不要用，因為大家都是高手，我都看不懂
作者: p212    時間: 2015-8-25 16:47

本帖最後由 p212 於 2015-8-25 16:52 編輯

回復 1# regedit77
1#範例中，Sheet2儲存格A2輸入「15」也只能對應出Sheet1之A欄項次15的一筆資料，公司名為「聯合機器」。
請問，為何還有另外二筆-項次9的「晶晶晶有限公司」與項次6的「阿三有限公司」？
如此似乎無規則，可否說明一下？
謝謝！
作者: ikboy    時間: 2015-8-25 17:41

如猜中你的意思，可將 B2:H2 公式下拉即可
B2==COUNTA($A$2:A2)
C2==VLOOKUP($A2,Sheet1!$A:$G,COLUMN(B1),0) 右拉至 H2
作者: lpk187    時間: 2015-8-25 17:59

回復 1# regedit77

如果只限定在A2輸入，那一定要程式才行，否則3樓的函數用法，倒是不錯的方式

我提供的是程式用法

    [attach]21802[/attach]
作者: regedit77    時間: 2015-8-25 20:59

非常感謝 p212、ikboy、lpk187 三位大大的指導，
可能我的語意不清，sorry ，我的意思就是如 lpk187 大大那的程式寫的那樣在一個格子裏
輸入然後對應其資料，附件中的第二筆及第三筆資料，就是A2 輸入時產生的

lpk187 大大寫的程式就是我所需要的，但現在就是輸入1-5 好像會對不到
程式碼我看不懂，功力還不夠，不太會改，可能要麻煩 lpk187 大大了

ikboy 也讓我學到原來可以反者思考，不要一直想在一個格子裏打轉，從後面反推回來
真是有才

總之感謝三位大大的用心  小女子 謝謝了
作者: lpk187    時間: 2015-8-25 21:39

回復 5# regedit77


    [attach]21804[/attach]
作者: regedit77    時間: 2015-8-27 19:31

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

再次感謝 lpk187
作者: regedit77    時間: 2015-11-22 07:01

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

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

因為一開始時，是想說不用程式的方法達成，所以就延續它下來，希望版主原諒
作者: lpk187    時間: 2015-11-22 14:10

回復 8# regedit77

[attach]22540[/attach]
檔案中有加了一個巨集，"清除"，是儲存格格式的文字色彩，改回原來的自動
作者: regedit77    時間: 2015-11-22 16:14

感謝 lpk187 大大 的幫忙，現在有兩個問題 第一個就是在office2003 下執行發生了如圖的錯誤，然後在office2013 下執行正常沒問題但按清除鈕後是把所有的內容資料清除，不是只有清除顏色，這樣的動作是正確的嗎，如果sheet1 的字是有斜體或粗體加顏色可以復製過去嗎，如果不行也沒關係，這樣就很棒了，謝謝lpk187大大[attach]22541[/attach][attach]22541[/attach][attach]22542[/attach][attach]22542[/attach]
作者: lpk187    時間: 2015-11-22 16:56

回復 10# regedit77


    按清除鈕後是把所有的內容資料清除，不是只有清除顏色，這樣的動作是正確的！！其實這動作也是當你清除資料後，也恢復原來文字的色彩，若不想在一起，你也可以把它分開
另外，會出現問題的地方應該是2003不支援，其實可以把那一列刪除掉的！
[attach]22543[/attach]
作者: regedit77    時間: 2015-11-22 17:16

謝謝 lpk187 大大 其實這樣就很好用了，很讚喔，不用太傷腦了，感謝
作者: 准提部林    時間: 2015-11-22 19:50

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)　'Ｂ欄最後一筆資料的下一空白格　
　　　Application.EnableEvents = False
　　　xF.Resize(1, 7).Copy xE　'複製內容（含格式）　
　　　xE = xE.Row - 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)
作者: regedit77    時間: 2015-11-23 08:03

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)