promotion image of download ymail app
Promoted
grace 發問時間: 電腦與網際網路軟體 · 6 年前

excel vba 合併填入資料

請問各位大大:

如何將d5與e5兩欄資料填入到另一個工作表上,並且以5列做一個合併填入.

檔案位置如下:

http://www.FunP.Net/161530

請求你的幫忙.謝謝

5 個解答

評分
  • Daniel
    Lv 7
    6 年前
    最佳解答

    Sub tFill()

    Application.ScreenUpdating = False

    With Sheets("輸入排程")

    R = .UsedRange.Rows.Count + 1

    If R > 8 Then .Range("9:" & R).Delete

    For R = 5 To Sheets("輸入名稱").[D5].End(4).Row

    K = (R - 4) * 5 + 4

    Sheets("輸入名稱").Cells(R, 4).Resize(, 2).Copy .Cells(K, 4)

    2014-11-23 14:13:32 補充:

    接上...

    Range("D" & K & ":IV" & K + 4).Borders.LineStyle = xlContinuous

    .Cells(K, 4).Resize(5).Merge

    .Cells(K, 5).Resize(5).Merge

    .Cells(K, 4).Resize(5, 6).Interior.ColorIndex = 34

    2014-11-23 14:13:52 補充:

    接上...

    For i = 0 To 4

    .Cells(K + i, 7).Resize(, 3).Borders(xlInsideVertical).LineStyle = xlNone

    Next

    Next

    Range("9:" & K + 4).RowHeight = 21

    End With

    End Sub

    2014-11-24 02:30:37 補充:

    使用VBA程式碼如下:

    Sub tFill()

    Application.ScreenUpdating = False

    With Sheets("輸入排程")

    R = .UsedRange.Rows.Count + 1

    If R > 8 Then .Range("9:" & R).Delete

    For R = 5 To Sheets("輸入名稱").[D5].End(4).Row

    K = (R - 4) * 5 + 4

    Sheets("輸入名稱").Cells(R, 4).Resize(, 2).Copy .Cells(K, 4)

    .Cells(K, 4).Resize(5).Merge

    .Cells(K, 5).Resize(5).Merge

    Next

    R = K + 4

    .Range("9:" & R).RowHeight = 21

    .Range("D9:I" & R).Interior.ColorIndex = 34

    .Range("D9:IV" & R).Borders.LineStyle = xlContinuous

    .Range("G9:I" & R).Borders(xlInsideVertical).LineStyle = xlNone

    End With

    End Sub

    此程式已將意見的程式稍作調整,執行效率較佳

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

    感謝各位大大熱情的幫忙:

    每位設計的方法.各有他的巧妙之處.都想選為最佳解答.但沒辦法實在很抱歉.以下還有延伸題可否再幫忙想辦法.謝謝~

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

    以上如果有言詞不當.得罪之處.敬請見諒!

    感恩~

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

    Sub 載入()

    Dim xR As Range, xE As Range, n&

    Call 清除: Set xE = [D14]

    For Each xR In Range([輸入名稱!D5], [輸入名稱!D65536].End(xlUp))

     If xR.Row < 5 Then Exit Sub

     Rows("9:13").Copy Rows(xE.Row)

    2014-11-23 17:29:54 補充:

     xE = xR: xE(1, 2) = xR(1, 2)

     Set xE = xE(6): n = n + 1

    Next

    Rows("9:13").EntireRow.Delete

    End Sub

     

    參考檔:

    http://www.funp.net/954254

    2014-11-23 17:51:30 補充:

    Sub 載入2()

    Dim xR As Range, xE As Range, y&

    Call 清除: Set xE = [D9]

    y = [輸入名稱!D65536].End(xlUp).Row - 4

    If y > 1 Then Rows("9:13").Copy Rows("14:" & y * 5 + 8)

    For Each xR In [輸入名稱!D5].Resize(y)

      xE = xR: xE(1, 2) = xR(1, 2)

      Set xE = xE(6)

    Next

    End Sub

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

    http://blog.xuite.net/hcm19522/twblog/259201087

    此為函數

    請教 大大們 ,若相隔格數E3是變數 ,如何自動跨欄置中 ,為版大所需

    • Commenter avatar登入以對解答發表意見
  • 您覺得這個回答如何?您可以登入為回答投票。
  • 小嵐
    Lv 4
    6 年前

    Sub 移動()

    Dim k, h

    h = Sheets("輸入名稱").[A65536].End(xlUp).Row

    k = 9

    For i = 2 To h

    Sheets("輸入排程").Cells(k, 4) = Sheets("輸入名稱").Cells(i, 1)

    Sheets("輸入排程").Cells(k, 5) = Sheets("輸入名稱").Cells(i, 2)

    k = k + 5

    Next i

    End Sub

    2014-11-23 08:22:53 補充:

    Sub 巨集1()

    Sheets("輸入排程").Select

    Sheets("輸入排程").Cells(9, 4).Select

    For i = 2 To Sheets("輸入名稱").[A65536].End(xlUp).Row

    ActiveCell.Value = Sheets("輸入名稱").Cells(i, 1)

    ActiveCell.Offset(0, 1).Range("A1") = Sheets("輸入名稱").Cells(i, 2)

    ActiveCell.Offset(1, 0).Range("A1").Select

    Next i

    End Sub

    2014-11-23 09:19:57 補充:

    Sub 巨集1()

    Sheets("輸入排程").Select

    Cells(9, 4).Select

    For i = 5 To Sheets("輸入名稱").[D65536].End(xlUp).Row

    ActiveCell.Value = Sheets("輸入名稱").Cells(i, 4)

    ActiveCell.Offset(0, 1).Range("A1") = Sheets("輸入名稱").Cells(i, 5)

    ActiveCell.Offset(1, 0).Range("A1").Select

    Next i

    End Sub

    2014-11-23 09:21:38 補充:

    Sub 移動()

    Dim k, h

    h = Sheets("輸入名稱").[D65536].End(xlUp).Row

    k = 9

    For i = 5 To h

    Sheets("輸入排程").Cells(k, 4) = Sheets("輸入名稱").Cells(i, 4)

    Sheets("輸入排程").Cells(k, 5) = Sheets("輸入名稱").Cells(i, 5)

    k = k + 5

    Next i

    End Sub

    參考資料: 初學, 不好意思請修正從D5開始, 不好意思請修正從D5開始
    • Commenter avatar登入以對解答發表意見
還有問題?馬上發問,尋求解答。