Board logo

標題: [發問] 資料合併問題 [打印本頁]
作者: smallpoper    時間: 2014-12-22 21:37     標題: 資料合併問題

請教大神~~範例檔中有2個sheet,sheet(合併前)是原始資料,如果想要呈現像sheet(合併後)的樣子,請問代碼該怎麼寫?
作者: ashan0418    時間: 2014-12-25 09:23

回復 1# smallpoper

先將檔案另存為『xlsm』，再將以下程式加入模組中!!
  1. Sub test()
  2.     Sheets("合併後").Cells.Delete Shift:=xlUp
  3.     Sheets("合併後").Range("A1:j1") = Array("No", "X", "Y", "TESTERNO", "BINNO", "VF", "VB", "VB1", "IR", "IR1")
  4.     Sheets("合併前").Select
  5.     Cells(1, 1).Select
  6.     i = 1
  7.     Do
  8.         str1 = Cells(1, i).Value
  9.         last_row = Cells(1, i + 1).End(xlDown).Row
  10.         Sheets(1).Range(Cells(2, i), Cells(last_row, i + 9)).Copy
  11.         Sheets(2).Select
  12.         Sheets(2).[a65535].End(xlUp).Offset(1).PasteSpecial
  13.         ActiveCell.Resize(last_row - 1).Value = str1
  14.         i = i + 11
  15.         Sheets(1).Select
  16.     Loop While Sheets(1).Cells(1, i).Value <> ""
  17.     [a1].Activate
  18.     ThisWorkbook.Save
  19.    
  20.     MsgBox "合併完成!!"
  21. End Sub
複製代碼
作者: GBKEE    時間: 2014-12-25 10:45

回復 2# ashan0418
另一寫法
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, i As Integer, ii As Long, Ar()
  4.     Set Rng = Sheets("合併前").Rows(1).SpecialCells(xlCellTypeConstants)
  5.     With Sheets("合併後")
  6.         .UsedRange.Clear
  7.         For i = 1 To Rng.Areas.Count
  8.             If i = 1 Then
  9.                 Ar = Rng.Areas(i).CurrentRegion
  10.                 Ar(1, 1) = "N0"
  11.             Else
  12.                 With Rng.Areas(i).CurrentRegion
  13.                     Ar = Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count))
  14.                 End With
  15.             End If
  16.             For ii = IIf(i = 1, 2, 1) To UBound(Ar)
  17.                 Ar(ii, 1) = Rng.Areas(i).Cells(1)
  18.             Next
  19.             With .Cells(.Rows.Count, "A").End(xlUp)
  20.                 .Offset(IIf(.Row = 1, 0, 1)).Resize(UBound(Ar), UBound(Ar, 2)) = Ar
  21.             End With
  22.         Next
  23.     End With
  24. End Sub
複製代碼
作者: ashan0418    時間: 2014-12-25 17:12

回復 3# GBKEE

感謝 GBKEE 大大的指導，
您寫的程式真的是太深奧了，
光是『SpecialCells(xlCellTypeConstants)』所延伸出來的問題我就研究好久了，
請問有相關的書籍可以參考嗎??
作者: GBKEE    時間: 2014-12-25 21:33

回復 4# ashan0418
VBA 的說明多看看,會進步的
作者: ashan0418    時間: 2014-12-26 09:31

回復 5# GBKEE

GBKEE 大大，請問您是指Excel的說明嗎??

就『SpecialCells(xlCellTypeConstants)』我就查不到了，
是我在安裝office時就沒有安裝嗎??

[attach]19949[/attach]



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