promotion image of download ymail app
Promoted

FB社團用拖拉貼上EXCEL再用VBA整理,謝謝。

FB社團用拖拉貼上EXCEL再用VBA整理,謝謝。需求說明1.這是FB的網頁,我直接拖拉複製到EXCEL。2.原檔是三個人三欄,應該都是固定格式,希望變成一人一列的模式。3.按需求的難易區分如下:[1]。C+D+E欄是必需的[2]。照片假如不好抓就算了,但是希望有最好[很想要有]。[3]。C欄+E欄盡量超連結,沒有就算了。請參閱:http://www.FunP.Net/931243FB社團明細.rar

已更新項目:

准提大師說檔案有問題,重新UPLOAD一次:

http://www.FunP.Net/806762

00FB社團明細02.rar

假如再有問題就重PO DB:DROPBOX~

2 個已更新項目:

感謝大師幫大忙,寫得相當好,速度又快,太棒了,沒意見就要結案囉。

新的比較複雜且更重要的衍生題,目前彙整中,又逢假日,需要一點時間喔,感謝。

3 個已更新項目:

新題出來囉,條件更特殊喔,先感謝VBA大師工程師了。

https://tw.knowledge.yahoo.com/question/question?q...

【衍生題】FB社團用拖拉貼上EXCEL再用VBA整理,謝謝。

3 個解答

評分
  • 5 年前
    最佳解答

    範例檔開起來像中毒, office版本太舊, 幫不上忙!

    2015-05-28 13:27:30 補充:

    Sub Test()

    Dim xR As Range, xE As Range, T$, N%

    [需求檔!2:6000].Delete

    Application.ScreenUpdating = False

    For Each xR In Sheets("原檔").UsedRange

    2015-05-28 13:27:41 補充:

     If xR.Hyperlinks.Count = 0 Then GoTo 101

     Set xE = [需求檔!A65536].End(xlUp)(2)

     xE = xE.Row - 1

     T = xR.Hyperlinks(1).Address

     xE.Hyperlinks.Add Anchor:=xE(1, 3), Address:=T, TextToDisplay:=xR.Value

    2015-05-28 13:27:48 補充:

     xE.Hyperlinks.Add Anchor:=xE(1, 4), Address:=T

     N = InStr(T & "?", "?")

     T = Left(T, N - 1)

     xE.Hyperlinks.Add Anchor:=xE(1, 5), Address:=T

    101: Next

    End Sub

    2015-05-28 13:29:15 補充:

    檔案開啟有錯誤訊息,沒有圖片(office 2000),

    只能處理資料,逐格設超連結,資料多快不了~~

     

    2015-05-29 13:03:38 補充:

    <參考檔>:

    http://www.funp.net/221924

    原檔圖片若沒有貼準位置,程式也沒辦法~~

    2015-05-29 15:37:50 補充:

    要留ID, 改這一行:

    N = InStr(Replace(T, "?", "&") & "&fref", "&fref")

    http://www.funp.net/495087

    2015-05-29 21:09:25 補充:

    EXCEL VBA.匯整三欄資料.超連結及圖片為明細格式

                             <.准提部林.>

    ---------------------------------

    ■程式碼:

    Sub Test()

    Dim xR As Range, xE As Range, T$, N%, P&(1)

    Call 清除

    Application.ScreenUpdating = False

    P(0) = ActiveSheet.Shapes.Count

    For Each xR In Sheets("原檔").UsedRange

     If xR.Hyperlinks.Count = 0 Then GoTo 101

     Set xE = [需求檔!A65536].End(xlUp)(2)

     xE = xE.Row - 1

     T = xR.Hyperlinks(1).Address

     xE.Hyperlinks.Add Anchor:=xE(1, 3), Address:=T, TextToDisplay:=xR.Value

     xE.Hyperlinks.Add Anchor:=xE(1, 4), Address:=T

     N = InStr(Replace(T, "?", "&") & "&fref", "&fref")

     T = Left(T, N - 1)

     xE.Hyperlinks.Add Anchor:=xE(1, 5), Address:=T

     

     xR(0).Resize(2).Copy [G1]

     P(1) = ActiveSheet.Shapes.Count

     If P(1) = P(0) Then GoTo 101

     P(0) = P(1)

     With ActiveSheet.Shapes(P(1))

       .LockAspectRatio = msoFalse

       .Left = xE(1, 2).Left + 2

       .Top = xE(1, 2).Top + 2

       .Height = xE(1, 2).Height - 4

       .Width = xE(1, 2).Width - 4

     End With

    101: Next

    [G1:G2].Clear

    End Sub

    ---------------------------------

    <範例檔>下載:

    檔案名稱:20150529a01(資料圖片重整明細)

    下載連結:http://www.funp.net/495087

    • Commenter avatar登入以對解答發表意見
  • 大師

    謝謝,我的OFFICE是2003應該一樣的,我再重新UPLOAD一次看看喔,謝謝。

    2015-05-27 22:31:26 補充:

    大師

    辛苦了,請再試試看囉。

    http://www.FunP.Net/806762

    00FB社團明細02.rar

    2015-05-28 13:53:46 補充:

    大師

    謝謝,真是感恩喔,抽空來試試看,圖片部分,建議大師用自己的手上圖片去測試就可以囉,反正格子都是固定的,之前的發問題圖片都很順利的,不然我先試試看您的意見的VBA,然後再用我自己的圖片來貼上再UPLOAD,而不用FB的好嗎,FB的資料很囉嗦的,有可能是FB的實際圖片出現問題。

    2015-05-28 14:03:58 補充:

    太棒了,速度好快喔,我來測試多一點的人看看喔,假如成功,我就來找上次的發問的那種照片,或是請大師用自己的照片來測試,然後把 VBA PO 上意見,我再來測試大量的圖片,這樣也是有同等功效喔,我好喜歡這些照片,可以幫我省下不少人工的浪費,真的好有需求,恭請大師務必要幫忙喔,上次請問大師的那個圖片的那題,運作就相當順利的,謝謝喔,感恩。

    2015-05-28 14:12:08 補充:

    測試203人,點一下就出來了,真的是秒救啊,大師真的是在普渡眾生啊,不然我會被整死的,真是大大的感謝,有關照片,請大師再幫忙一下,您寫VBA我來測試,OK,等大師囉,謝謝。

    2015-05-28 20:34:54 補充:

    大師好

    這次的照片是用上次發問的照片,應該沒問題才對囉,請試試看,謝謝。

    http://www.FunP.Net/912414

    00PHPTO.rar

    2015-05-29 13:45:11 補充:

    大師

    真是感謝喔,太棒了,大師最謙虛了,每次都說會跑很久與圖片瞄不準,可是測試都是超過100分喔,太高興了,我來測試200多人的看看,甚至3000人的,我想把大師的程式好好了解一下喔,這樣就可以運用到很多網頁的照片,可以省掉太多太多的寶貴時間了,真是我的大恩人,讓我來慢慢的玩一下程式喔,請大師趁此機會整一下資料,讓大家都可以運用,謝謝,大師午安。

    2015-05-29 14:02:39 補充:

    大師

    E欄[修整URL]跟D欄差距很大,請幫忙看一下,謝謝。

    2015-05-29 15:59:47 補充:

    讚啦~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    好棒喔~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    2015-05-29 16:58:10 補充:

    大師

    我有運用到另一個網頁,格式不同,但大同小異,看到大師寫的 VBA 相當活與有智慧,我是寫不出來的。

    新的這個網頁架構都差不多,就是圖片特大,佔滿1.2.3.4列,網頁畫面上看有兩個人頭,複製與貼上EXCEL之後變一欄,本題是三欄。

    假如把圖片用人工縮小成跟本題一樣,可以抓得到,但是新網頁就是佔滿A1.2.3.4列,請問大師我改去改 VBA 的哪裡呢?是不是P1與P0那邊呢,請大師指點一下囉,感謝喔。

    2015-05-29 17:08:36 補充:

    不過我剛仔細看了一下,超連結多出兩個,條件似乎有很大的不同,這題在運用上算成功了,我再衍生另外一題,新題就是我使用FB以來,最感困擾的地方,是我的好友群的美照,希望能夠把她抓出來,我之前都用人工抓的,把我苦死了,請大師救救我囉,抽空把新題整一下,這題就先請大師上台發表,謝謝喔。

    2015-05-29 21:33:40 補充:

    2015-05-29 21:33:04 補充

    感謝大師幫大忙,寫得相當好,速度又快,太棒了,沒意見就要結案囉。

    新的比較複雜且更重要的衍生題,目前彙整中,又逢假日,需要一點時間喔,感謝。

    2015-05-30 14:32:12 補充:

    2015-05-30 14:31:38 補充

    新題出來囉,條件更特殊喔,先感謝VBA大師工程師了。

    https://tw.knowledge.yahoo.com/question/question?q...

    【衍生題】FB社團用拖拉貼上EXCEL再用VBA整理,謝謝。

    • Commenter avatar登入以對解答發表意見
  • 5 年前

    你好  我是MIS的佳霓

    不好意思打擾了~若有空可以參考一下喔!!

    如果你覺得薪水總是不夠用,想增加更多收入

    可告下班時間兼差這網賺事業~他是100%不用出門,

    更不需要去跟親朋好友推銷了,因為它並不是直銷

    我只是一位上班族~我薪水加上這份額外收入,

    已經比我公司主管收入還要多了,

    連我同事都找我教他們做,如果你想了解我是怎辦到的!

    請點此加我臉書:https://www.facebook.com/emily.lin.399

    加入此網賺並不會收入會費~不用擔心!!

    快來看看我每個月兼差56K的方法

    >>http://5718050297b.weebly.com/

    只要你下定決心 願意犧牲下班時間 掌握先機

    ----- 請馬上和我聯絡 -----

    FB與我聯絡:https://www.facebook.com/emily.lin.399

    • Commenter avatar登入以對解答發表意見
還有問題?馬上發問,尋求解答。